Psychological Determinants of the Susceptibility to Fake News amidst the COVID-19 Pandemic
Supplementary Materials
Methods
Packages & Data
Packages
library(tidyverse)
library(easystats)> # Attaching packages (red = needs update)
> <U+26A0> insight 0.12.0.1 <U+26A0> bayestestR 0.8.0.1
> <U+26A0> performance 0.7.0.1 <U+26A0> parameters 0.10.1
> <U+26A0> see 0.6.1.1 <U+26A0> effectsize 0.4.1.1
> <U+26A0> correlation 0.5.0 <U+26A0> modelbased 0.5.0
> <U+26A0> report 0.2.0
> Warnings or errors in CRAN checks for package(s) 'bayestestR', 'modelbased', 'correlation'.
> Restart the R-Session and update packages in red with 'easystats::easystats_update()'.library(reshape2)
library(cowplot)
library(ggraph)
library(formattable)
library(formatR)
library(lme4)
library(patchwork)
library(ggeffects)
library(ggplot2)
library(stringr)
library(parameters)
library(performance)
library(see)
library(glmmTMB)
library(waffle)
library(lavaan)
set.seed(333)Raw Data
This contains data from a Singapore sample and a UK sample.
df_raw <- read.csv("data2.csv", stringsAsFactors = FALSE, na.string = c("", "NA"))Measures Scoring
Utility Functions
# Reverse negative items
reverse <- function(x, mini, maxi) {
maxi - x + mini
}
# Visualization distribution with stats
descriptive_statistics <- function(df, begins_with, dataset = NULL) {
df %>% select(dplyr::starts_with(begins_with)) %>% report::report()
}
descriptive_plot <- function(df, begins_with, dataset = NULL) {
df %>% select(dplyr::starts_with(begins_with)) %>% bayestestR::estimate_density(method = "KernSmooth") %>%
plot() + labs(x = "Scores", y = "Density", color = "Parameter") + ggtitle(paste("Distribution of",
begins_with, "scores:", dataset)) + see::theme_modern()
}
# Wrangle dataframe and plot (for COVID measures)
dataframe_wrangle <- function(df_final, dataset = NULL) {
belief <- df_final %>% select(starts_with("Belief_"), "Participant") %>% melt() %>%
arrange(Participant) %>% mutate(variable = str_remove(variable, "Belief_")) %>%
rename(Measure = variable, Belief = value)
compliance <- df_final %>% select(starts_with("Compliance_"), "Participant") %>%
melt() %>% arrange(Participant) %>% mutate(variable = str_remove(variable,
"Compliance_")) %>% rename(Measure = variable, Compliance = value)
covid_measures <- merge(belief, compliance, by.y = c("Participant", "Measure")) %>%
mutate(Measure = ifelse(Measure == "Distancing", "Social Distancing", ifelse(Measure ==
"Face", "Not touching Face", ifelse(Measure == "Mask", "Wearing a Mask",
ifelse(Measure == "WashHands", "Washing Hands", "Staying Home")))))
covid_measures %>% ggplot(aes(x = Belief, y = Compliance, colour = Measure, fill = Measure)) +
geom_jitter() + geom_smooth(method = "lm", alpha = 0.2) + ggtitle(paste("r =",
insight::format_value(cor.test(covid_measures$Belief, covid_measures$Compliance)$estimate),
":", dataset)) + ggpubr::stat_cor(aes(color = Measure), label.x = 3) + theme_modern()
}
# Report CFA indices
report_cfa_indices <- function(comparison, row = 1, name = "<model>") {
paste0("(X2", name, " = ", insight::format_value(comparison[row, "Chisq"]), ", AIC",
name, " = ", insight::format_value(comparison[row, "AIC"]), ", BIC", name,
" = ", insight::format_value(comparison[row, "BIC_adjusted"]), ", RMSEA",
name, " = ", insight::format_value(comparison[row, "RMSEA"]), ", CFI", name,
" = ", insight::format_value(comparison[row, "CFI"]), ", SRMR", name, " = ",
insight::format_value(comparison[row, "SRMR"]), ")")
}Rescale News Item
df_raw[stringr::str_detect(names(df_raw), "News_")] <- effectsize::change_scale(df_raw[stringr::str_detect(names(df_raw),
"News_")], from = c(0, 6), to = c(-5, 5))Personality Questionnaires
The Brief Self-Control Scale (BSCS), Paranoid Thought Scale (GPTS), and Emotionality (PANAS) were scored from 0 to 4; Conspiracist Mentality Questionnaire (CMQ) was scored from 0 to 10; Paranormal Belief Scale (PBS-R) and Intolerance Uncertainty Scale (IUS) were scored from 0 to 6; Interoception (MAIA) was scored from 0 to 5, and Schizotypy Personality (SPQ) was scored in a binary manner (1 if “Yes”, 0 if “No”). The greater the scores, the stronger the traits of interest.
df_raw <- df_raw %>%
# BSCS
mutate_at(vars("BSCS_1", "BSCS_9", "BSCS_11", "BSCS_12"), reverse, mini = 0, maxi = 4) %>%
mutate(BSCS_General = BSCS_1 + BSCS_2 + BSCS_3 + BSCS_4 + BSCS_5 + BSCS_6 + BSCS_7 +
BSCS_8 + BSCS_9 + BSCS_10 + BSCS_11 + BSCS_12 + BSCS_13) %>%
# CMQ
mutate(CMQ_General = (CMQ_1 + CMQ_2 + CMQ_3 + CMQ_4 + CMQ_5)/5) %>%
# GPTS
mutate(GPTS_Reference = GPTS_1 + GPTS_2 + GPTS_3 + GPTS_4 + GPTS_5 + GPTS_6 + GPTS_7 +
GPTS_8, GPTS_Persecution = GPTS_9 + GPTS_10 + GPTS_11 + GPTS_12 + GPTS_13 + GPTS_14 +
GPTS_15 + GPTS_16 + GPTS_17 + GPTS_18) %>% mutate(GPTS_General = (GPTS_Reference +
GPTS_Persecution)/2) %>%
# IUS
mutate(IUS_InhibitoryAnxiety = IUS_8 + IUS_9 + IUS_10 + IUS_11 + IUS_12, IUS_ProspectiveAnxiety = IUS_1 +
IUS_2 + IUS_3 + IUS_4 + IUS_5 + IUS_6 + IUS_7) %>% mutate(IUS_General = (IUS_InhibitoryAnxiety +
IUS_ProspectiveAnxiety)/2) %>%
# MAIA2
mutate_at(vars("MAIA2_5", "MAIA2_6", "MAIA2_9"), reverse, mini = 0, maxi = 5) %>%
mutate(MAIA_EmotionalAwareness = (MAIA2_10 + MAIA2_11 + MAIA2_12 + MAIA2_13 +
MAIA2_14)/5, MAIA_NotWorrying = (MAIA2_5 + MAIA2_6 + MAIA2_7 + MAIA2_8 +
MAIA2_9)/5, MAIA_Noticing = (MAIA2_1 + MAIA2_2 + MAIA2_3 + MAIA2_4)/4) %>%
mutate(MAIA_General = (MAIA_EmotionalAwareness + MAIA_Noticing + MAIA_NotWorrying)/3) %>%
# PBS
mutate_at(vars("PBS_14"), reverse, mini = 0, maxi = 6) %>% mutate(PBS_ReligiousBeliefs = (PBS_1 +
PBS_5 + PBS_9 + PBS_13)/4, PBS_Precognition = (PBS_4 + PBS_8 + PBS_12 + PBS_16)/4,
PBS_Psi = (PBS_2 + PBS_6 + PBS_10 + PBS_14)/4, PBS_Spiritualism = (PBS_3 + PBS_7 +
PBS_11 + PBS_15)/4) %>% mutate(PBS_General = (PBS_ReligiousBeliefs + PBS_Precognition +
PBS_Psi + PBS_Spiritualism)/4) %>%
# SPQ
mutate_at(vars(starts_with("SPQ")), function(x) ifelse(x == "Yes", 1, 0)) %>% mutate(SPQ_CognitivePerceptual = SPQ_2 +
SPQ_4 + SPQ_5 + SPQ_9 + SPQ_10 + SPQ_12 + SPQ_16 + SPQ_17, SPQ_Disorganized = SPQ_3 +
SPQ_6 + SPQ_8 + SPQ_13 + SPQ_19 + SPQ_20, SPQ_Interpersonal = SPQ_1 + SPQ_7 +
SPQ_11 + SPQ_14 + SPQ_15 + SPQ_18 + SPQ_21 + SPQ_22) %>% mutate(SPQ_General = SPQ_CognitivePerceptual +
SPQ_Disorganized + SPQ_Interpersonal) %>%
# PANAS
mutate(PANAS_Negative_State = PANAS_State_Afraid + PANAS_State_Ashamed + PANAS_State_Distressed +
PANAS_State_Upset + PANAS_State_Guilty + PANAS_State_Hostile + PANAS_State_Irritable +
PANAS_State_Nervous + PANAS_State_Jittery + PANAS_State_Scared, PANAS_Negative_Trait = PANAS_Trait_Afraid +
PANAS_Trait_Ashamed + PANAS_Trait_Distressed + PANAS_Trait_Upset + PANAS_Trait_Guilty +
PANAS_Trait_Hostile + PANAS_Trait_Irritable + PANAS_Trait_Nervous + PANAS_Trait_Jittery +
PANAS_Trait_Scared)
# Remove individual questionnaire items df_raw <- df_raw %>%
# select(-matches('CMQ_\\d')) %>% select(-matches('BSCS_\\d')) %>%
# select(-matches('PBS_\\d')) %>% select(-matches('SPQ_\\d')) %>%
# select(-matches('MAIA2_\\d')) %>% select(-matches('GPTS_\\d')) %>%
# select(-matches('IUS_\\d')) %>% select(-matches('PANAS_State')) %>%
# select(-matches('PANAS_Trait'))Data Exclusion
Exclude Failed Attention Checks
df_complete <- df_raw %>% # filter_at(vars(matches('CMQ|PBS|GPTS|BSCS|SPQ|IUS|PANAS|MAIA')),
# all_vars(!is.na(.))) %>% filter_at(vars(starts_with('News_')),
# all_vars(!is.na(.))) # Compulsory columns
filter(AttentionCheck_1 == "Yes" & AttentionCheck_2 == "Washing Hands")
paste("We excluded", nrow(df_raw) - nrow(df_complete), "participants who failed attention checks.")> [1] "We excluded 93 participants who failed attention checks."Exclude based on Time Completion
library(gridExtra)
df_time <- df_complete %>% filter(Duration < 120) # Less than 2 hours
# Compute highest density intervals
ci <- bayestestR::eti(df_time$Duration, ci = c(0.8, 0.9, 0.95, 0.99))
cat(paste0("Duration Intervals:\n", paste0(" - ", insight::format_ci(ci$CI_low,
ci$CI_high, ci$CI/100), collapse = "\n")))> Duration Intervals:
> - 80% CI [13.56, 53.67]
> - 90% CI [12.28, 68.91]
> - 95% CI [10.81, 91.97]
> - 99% CI [8.41, 114.02]upper_limit <- ci[ci$CI == 90, "CI_high"]
lower_limit <- ci[ci$CI == 90, "CI_low"]
# Estimates
mode_duration <- bayestestR::map_estimate(df_time$Duration)
tab <- as.data.frame(c(CI_low = round(describe_posterior(df_time$Duration)$CI_low,
2), CI_high = round(describe_posterior(df_time$Duration)$CI_high, 2), MAP = round(as.numeric(mode_duration),
2)))
p_tab <- tableGrob(unname(tab))
# Visualize
t <- ci %>% plot(show_zero = FALSE, show_title = FALSE) + geom_vline(xintercept = c(upper_limit,
lower_limit), color = "red", linetype = "dashed", size = 1) + geom_vline(xintercept = mean(df_time$Duration),
color = "orange", linetype = "dashed", size = 1) + annotate("text", x = mean(df_time$Duration) +
7, y = 1, label = paste("Mean Duration = ", round(mean(df_time$Duration), 2),
"mins")) + annotate("text", x = lower_limit - 3, y = 1, label = "CI_low") + annotate("text",
x = upper_limit + 3, y = 1, label = "CI_high") + theme_modern() + scale_fill_viridis_d() +
ylab("Distribution") + xlab("Time to complete (in minutes)")
time_plot <- grid.arrange(t, p_tab, ncol = 2, widths = c(1, 0.2))
# Exclude
df_time <- df_time %>% filter(Duration > lower_limit)
paste("We excluded", nrow(df_complete) - nrow(df_time), "participants who took more than 2 hours to complete the study and with a completion time outside the 95% percentile (>",
insight::format_value(lower_limit), "min). The mode duration is approximately",
round(mode_duration, 2), "min.")> [1] "We excluded 59 participants who took more than 2 hours to complete the study and with a completion time outside the 95% percentile (> 12.28 min). The mode duration is approximately 18.49 min."Multivariate outliers
# methods <- c('zscore', 'iqr', 'mahalanobis', 'robust', 'mcd', 'ics', 'iforest',
# 'lof') lof, robust, mcd, ics, mahalanobis doesn't work with NA values methods
# <- c('zscores', 'iqr', 'iforest') outliers_2 <- df_time %>%
# select(intersect(starts_with('News_'), ends_with('_Belief')),
# matches('CMQ|PBS|GPTS|BSCS|SPQ|IUS|PANAS|MAIA')) %>% effectsize::standardize()
# outliers_2 <- performance::check_outliers(outliers_2, method = methods) #
# Visualise as.data.frame(outliers_2) %>% mutate(Outlier =
# as.factor(paste0(round(Outlier*3), '/', length(methods)))) %>% ggplot(aes(x =
# Outlier, fill = Outlier)) + geom_bar() + geom_vline(aes(xintercept = 6.5),
# color = 'red', linetype = 'dotted') + theme_modern() +
# see::scale_fill_metro_d(guide = FALSE) + xlab('Proportion of methods aggreeing
# on an outlier') + ylab('Number of participants') save(outliers_2,
# file='outliers_2.Rdata') load('outliers_2.Rdata')
# df_final <- df_time[-which(as.numeric(outliers_2) >= 2/length(methods)), ]
# paste('We excluded', nrow(df_time) - nrow(df_final), 'participants that were
# classified as outliers by at least', 2/length(methods), 'of the methods used.')Final Samples
# Remove participants who do not live in the country and are not citizens
df_final <- df_time %>% filter(Country_Residence == "Yes" | Country_Citizenship ==
"Yes")
paste("We excluded", nrow(df_time) - nrow(df_final), "participants who were neither citizens of the country nor lived there.")> [1] "We excluded 12 participants who were neither citizens of the country nor lived there."# Label participants
df_final <- df_final %>% mutate(Participant = paste0("S", 1:nrow(df_final)))
# Convert to factors
df_final$Dataset <- as.factor(df_final$Dataset)
# Split into Different Datasets
df_sg <- df_final %>% filter(Dataset == "SG")
df_uk <- df_final %>% filter(Dataset == "UK")SG Sample
# Prepare
df_sg <- df_sg %>% mutate(Gender = as.factor(Gender), Education_Achieved = ifelse(!Education_Achieved %in%
c("A Levels", "Bachelors Degree", "Diploma", "Masters Degree or similar", "Doctoral Degree or similar",
"O/N Levels", NA), "Other", Education_Achieved), Education_Pursuing = ifelse(!Education_Pursuing %in%
c("Bachelors Degree", "Diploma", "Doctoral Degree or similar", "Masters Degree or similar",
NA), "Other", Education_Pursuing), Ethnicity = ifelse(!Ethnicity %in% c("Chinese",
"Malay", "Indian"), "Other", Ethnicity), Religion_Type = ifelse(!Religion_Type %in%
c("No religion", "Buddhism", "Christianity", "Taoism", "Hinduism", "Islam"),
"Other", Religion_Type)) %>% select(Participant, Gender, everything())
# Report
paste("The final Singapore sample included", report_participants(df_sg, sex = "Gender"))> [1] "The final Singapore sample included 336 participants (Mean age = 30.7, SD = 10.8, range: [19, 68]; 56.5% females; Mean education = 2.6, SD = 2.2, range: [-2, 10])"df_sg %>% select(System_Device, System_Screen, Duration, Age, Student, Education_Achieved,
Education_Pursuing, Ethnicity, starts_with("Religion"), Income) %>% report(levels_percentage = TRUE,
missing_percentage = TRUE, n_entries = 10)> The data contains 336 observations of the following variables:
> - System_Device: 3 entries, such as Phone (70.83%%); Computer (28.57%%); Tablet (0.60%%); NA; NA; NA; NA; NA; NA; NA(0.00% missing)
> - System_Screen: n = 336, Mean = 6.29e+05, SD = 5.98e+05, Median = 3.49e+05, MAD = 1.11e+05, range: [181760, 3686400], Skewness = 2.42, Kurtosis = 7.23, 0% missing
> - Duration: n = 336, Mean = 26.51, SD = 16.54, Median = 21.22, MAD = 8.06, range: [12.33, 114.92], Skewness = 2.92, Kurtosis = 10.43, 0% missing
> - Age: n = 336, Mean = 30.67, SD = 10.85, Median = 26.00, MAD = 5.93, range: [19, 68], Skewness = 1.42, Kurtosis = 1.33, 0% missing
> - Student: 2 entries, such as No (61.90%%); Yes (38.10%%); NA; NA; NA; NA; NA; NA; NA; NA(0.00% missing)
> - Education_Achieved: 7 entries, such as Bachelors Degree (36.90%%); Diploma (12.80%%); Masters Degree or similar (5.06%%); O/N Levels (4.76%%); Doctoral Degree or similar (1.19%%); A Levels (0.89%%); Other (0.30%%); NA; NA; NA(38.10% missing)
> - Education_Pursuing: 5 entries, such as Bachelors Degree (34.52%%); Diploma (1.19%%); Doctoral Degree or similar (1.19%%); Masters Degree or similar (0.60%%); Other (0.60%%); NA; NA; NA; NA; NA(61.90% missing)
> - Ethnicity: 4 entries, such as Chinese (85.42%%); Other (6.55%%); Indian (4.46%%); Malay (3.57%%); NA; NA; NA; NA; NA; NA(0.00% missing)
> - Religion_Type: 7 entries, such as No religion (27.98%%); Christianity (27.68%%); Buddhism (27.38%%); Islam (5.36%%); Other (4.76%%); Taoism (4.46%%); Hinduism (2.38%%); NA; NA; NA(0.00% missing)
> - Religion_Faith: n = 336, Mean = 4.56, SD = 3.11, Median = , MAD = 4.45, range: [0, 10], Skewness = -0.11, Kurtosis = -1.32, 2.08% missing
> - Religion_Engagement: n = 336, Mean = 3.71, SD = 3.20, Median = , MAD = 4.45, range: [0, 10], Skewness = 0.36, Kurtosis = -1.18, 2.68% missing
> - Income: n = 336, Mean = 2662.53, SD = 9278.78, Median = , MAD = 1315.81, range: [0, 150000], Skewness = 14.87, Kurtosis = 230.95, 18.45% missingUK Sample
# Prepare
df_uk <- df_uk %>% mutate(Participant = paste0("S", 1:nrow(df_uk)), Gender = as.factor(Gender),
Education_Achieved = ifelse(!Education_Achieved %in% c("A Levels", "Bachelors Degree",
"Diploma", "Masters Degree or similar", "Doctoral Degree or similar", "O/N Levels",
NA), "Other", Education_Achieved), Education_Pursuing = ifelse(!Education_Pursuing %in%
c("Bachelors Degree", "Diploma", "Doctoral Degree or similar", "Masters Degree or similar",
NA), "Other", Education_Pursuing)) %>% mutate(Ethnicity = ifelse(Ethnicity %in%
c("White - North European", "White - South European"), "White", ifelse(Ethnicity %in%
c("Chinese, Japanese, or other South East Asian", "Asian"), "Asian", ifelse(Ethnicity %in%
c("Hispanic", "Latina "), "Spain and Latin America", "Other")))) %>% mutate(Religion_Type = ifelse(Religion_Type %in%
c("Muslim", "Islam"), "Islam", ifelse(Religion_Type %in% c("Christadelphian",
"Christian Orthodox", "Christian ", "Protestant", "Catholic"), "Christianity",
ifelse(Religion_Type %in% c("Hindu"), "Hinduism", ifelse(Religion_Type %in% c("Buddhist"),
"Buddhism", "Other"))))) %>% select(Participant, Gender, everything())
# Report
paste("The final UK sample included", report_participants(df_uk, sex = "Gender"))> [1] "The final UK sample included 164 participants (Mean age = 22.0, SD = 5.7, range: [18, 52]; 81.1% females; Mean education = 2.4, SD = 1.8, range: [-2, 10])"df_uk %>% select(System_Device, System_Screen, Duration, Age, Student, Education_Achieved,
Education_Pursuing, Ethnicity, starts_with("Religion"), Income) %>% report(levels_percentage = TRUE,
missing_percentage = TRUE, n_entries = 10)> The data contains 164 observations of the following variables:
> - System_Device: 3 entries, such as Computer (82.32%%); Phone (17.07%%); Tablet (0.61%%); NA; NA; NA; NA; NA; NA; NA(0.00% missing)
> - System_Screen: n = 164, Mean = 1.09e+06, SD = 4.92e+05, Median = 1.05e+06, MAD = 3.66e+05, range: [250125, 3686400], Skewness = 0.88, Kurtosis = 4.45, 0% missing
> - Duration: n = 164, Mean = 40.26, SD = 20.11, Median = 32.39, MAD = 12.71, range: [12.28, 118.60], Skewness = 1.47, Kurtosis = 1.95, 0% missing
> - Age: n = 164, Mean = 21.98, SD = 5.67, Median = 20.00, MAD = 1.48, range: [18, 52], Skewness = 3.38, Kurtosis = 12.30, 0% missing
> - Student: 2 entries, such as Yes (96.95%%); No (3.05%%); NA; NA; NA; NA; NA; NA; NA; NA(0.00% missing)
> - Education_Achieved: 3 entries, such as Doctoral Degree or similar (1.22%%); Masters Degree or similar (1.22%%); A Levels (0.61%%); NA; NA; NA; NA; NA; NA; NA(96.95% missing)
> - Education_Pursuing: 5 entries, such as Bachelors Degree (76.22%%); Masters Degree or similar (12.20%%); Diploma (3.66%%); Other (3.05%%); Doctoral Degree or similar (1.83%%); NA; NA; NA; NA; NA(3.05% missing)
> - Ethnicity: 4 entries, such as White (75.61%%); Other (12.20%%); Asian (10.98%%); Spain and Latin America (1.22%%); NA; NA; NA; NA; NA; NA(0.00% missing)
> - Religion_Type: 4 entries, such as Other (70.73%%); Christianity (22.56%%); Hinduism (4.27%%); Islam (2.44%%); NA; NA; NA; NA; NA; NA(0.00% missing)
> - Religion_Faith: n = 164, Mean = 1.77, SD = 2.53, Median = , MAD = 0.00, range: [0, 10], Skewness = 1.44, Kurtosis = 0.99, 1.22% missing
> - Religion_Engagement: n = 164, Mean = 1.19, SD = 2.17, Median = , MAD = 0.00, range: [0, 9], Skewness = 2.08, Kurtosis = 3.27, 1.22% missing
> - Income: n = 164, Mean = 10465.14, SD = 34169.96, Median = , MAD = 1891.80, range: [0, 352000], Skewness = 8.42, Kurtosis = 78.62, 23.78% missingClustering of News Items (based on belief)
SG News
# df_sg_news <- df_sg %>% select(Participant, ends_with('_Belief')) %>% t %>%
# as.data.frame() %>% rownames_to_column() colnames(df_sg_news) <- df_sg_news[1,]
# df_sg_news <- df_sg_news[-1, -1] %>% mutate_if(is.character, as.numeric)
# sg_fake <- df_sg_news[1:11,] sg_real <- df_sg_news[12:21,] # Check cluster
# tendency parameters::check_clusterstructure(sg_fake, standardize = FALSE) %T>%
# print() %>% plot() # suitable parameters::check_clusterstructure(sg_real,
# standardize = FALSE) %T>% print() %>% plot() # suitable # How many cluster
# NbClust::NbClust(sg_fake, min.nc = 2, max.nc = 9, method = 'ward.D2')
# parameters::n_clusters(sg_fake, standardize = FALSE) %T>% print() %>% plot() +
# theme_modern() #The choice of 2 clusters is supported by 10 (35.71%) methods
# out of 28 (CH, CCC, Cindex, Silhouette, Duda, PseudoT2, Beale, Ratkowsky,
# McClain, Tibs2001SEmax). parameters::n_clusters(sg_real, standardize = FALSE)
# %T>% print() %>% plot() + theme_modern() #The choice of 2 clusters is supported
# by 6 (21.43%) methods out of 28 (CH, CCC, Duda, PseudoT2, Beale, McClain). (or
# 4) # Clustering w kmeans set.seed(333) k_fake <- kmeans(sg_fake, centers=2,
# iter.max = 10000, nstart = 1000) k_real <- kmeans(sg_real, centers=2, iter.max
# = 10000, nstart = 1000) model_parameters(k2) model_parameters(k3)Demographics
Overview
# Gender
gender_sg <- waffle(table(df_sg$Gender), rows = 7, size = 1, colors = c("#19b5fc",
"#306bf2"), xlab = paste("SG Sample, N =", sum(table(df_sg$Gender))))
gender_uk <- waffle(table(df_uk$Gender), rows = 5, size = 1, colors = c("#19b5fc",
"#306bf2"), xlab = paste("UK Sample, N =", sum(table(df_uk$Gender))))
gender_patch <- gender_sg/gender_uk + plot_layout(guides = "collect", heights = c(3,
1)) + plot_annotation(title = "Gender")
ggsave("figures/demographics_gender.png", gender_patch, height = figheight * 0.7,
width = figwidth, dpi = 600)
# Ethnicity
ethnicity_sg <- waffle(table(df_sg$Ethnicity), rows = 7, size = 1, colors = c("#97E597",
"#3CE53C", "#049204", "#316B31"), xlab = paste("SG Sample, N =", sum(table(df_sg$Ethnicity))))
ethnicity_uk <- waffle(table(df_uk$Ethnicity), rows = 5, size = 1, colors = c("#97E597",
"#3CE53C", "#049204", "#316B31"), xlab = paste("UK Sample, N =", sum(table(df_uk$Ethnicity))))
ethnicity_patch <- ethnicity_sg/ethnicity_uk + plot_layout(nrow = 2, heights = c(3,
1)) + plot_annotation(title = "Ethnicity")
ggsave("figures/demographics_ethnicity.png", ethnicity_patch, height = figheight *
0.7, width = figwidth, dpi = 600)
# Religion
religion_sg <- waffle(sort(table(df_sg$Religion_Type), decreasing = TRUE), rows = 7,
size = 1, colors = c("#E7ABF6", "#C295F7", "#D347F4", "#8C43E3", "#9A0CBB", "#5B12B2",
"#67077E"), xlab = paste("SG Sample, N =", sum(table(df_sg$Religion_Type))))
religion_uk <- waffle(sort(table(df_uk$Religion_Type), decreasing = TRUE), rows = 5,
size = 1, colors = c("#E7ABF6", "#C295F7", "#8C43E3", "#5B12B2"), xlab = paste("UK Sample, N =",
sum(table(df_uk$Religion_Type))))
religion_patch <- religion_sg/religion_uk + plot_layout(nrow = 2, heights = c(3,
1)) + plot_annotation(title = "Religion")
ggsave("figures/demographics_religion.png", religion_patch, height = figheight *
0.7, width = figwidth, dpi = 600)
# Working Adults: Education
education_achieved_sg <- waffle(sort(table(df_sg$Education_Achieved), decreasing = TRUE),
rows = 7, size = 1, colors = c("#F6CCE8", "#ffa7d8", "#E58AC6", "#FF38BB", "#FF0092",
"#AB0A66", "#67043D"), xlab = paste("SG Sample, N =", sum(table(df_sg$Education_Achieved))))
education_achieved_uk <- waffle(sort(table(df_uk$Education_Achieved), decreasing = TRUE),
rows = 1, size = 1, colors = c("#F6CCE8", "#ffa7d8", "#E58AC6", "#FF38BB", "#FF0092",
"#AB0A66", "#67043D"), xlab = paste("UK Sample, N =", sum(table(df_uk$Education_Achieved))))
education_achieved_patch <- education_achieved_sg/education_achieved_uk + plot_layout(nrow = 2,
heights = c(10, 1)) + plot_annotation(title = "Non-Students: Education Levels")
ggsave("figures/demographics_educationachieved.png", education_achieved_patch, height = figheight *
0.7, width = figwidth, dpi = 600)
# Students: Education
education_pursuing_sg <- waffle(sort(table(df_sg$Education_Pursuing), decreasing = TRUE),
rows = 5, size = 1, colors = c("#F7E497", "#F2CB35", "#FFB400", "#D6801F", "#A75B05"),
xlab = paste("SG Sample, N =", sum(table(df_sg$Education_Pursuing))))
education_pursuing_uk <- waffle(sort(table(df_uk$Education_Pursuing), decreasing = TRUE),
rows = 5, size = 1, colors = c("#F7E497", "#F2CB35", "#FFB400", "#D6801F", "#A75B05"),
xlab = paste("UK Sample, N =", sum(table(df_uk$Education_Pursuing))))
education_pursuing_patch <- education_pursuing_sg/education_pursuing_uk + plot_layout(nrow = 2,
heights = c(1, 1)) + plot_annotation(title = "Students: Education Levels (Currently Pursuing)")
ggsave("figures/demographics_educationpursuing.png", education_pursuing_patch, height = figheight *
0.7, width = figwidth, dpi = 600)
# COVID Diagnosis
covid_sg <- waffle(sort(table(df_sg$COVID_Diagnosis), decreasing = TRUE), rows = 7,
size = 1, colors = c("#F2AAAA", "#EC6640", "#FF0B00"), xlab = paste("SG Sample, N =",
sum(table(df_sg$COVID_Diagnosis))))
covid_uk <- waffle(sort(table(df_uk$COVID_Diagnosis), decreasing = TRUE), rows = 5,
size = 1, colors = c("#F2AAAA", "#EC6640", "#FF0B00", "#B30800"), xlab = paste("UK Sample, N =",
sum(table(df_uk$COVID_Diagnosis))))
covid_patch <- covid_sg/covid_uk + plot_layout(nrow = 2, heights = c(3, 1)) + plot_annotation(title = "COVID-19 Status")
ggsave("figures/demographics_covid.png", covid_patch, height = figheight * 0.7, width = figwidth,
dpi = 600)Income
# SG Income
mean_income_sg <- df_sg %>% filter(Student == "No") %>% filter(!is.na(Education_Achieved)) %>%
filter(!is.na(Income)) %>% summarize(mean = mean(Income))
mean_income_sg <- mean_income_sg$mean
p_income_sg <- df_sg %>% filter(Student == "No") %>% filter(!is.na(Education_Achieved)) %>%
filter(!is.na(Income)) %>% ggplot(aes(x = Income, color = Education_Achieved)) +
geom_density(size = 1, alpha = 0.3) + labs(colour = "Education Level") + xlab("Monthly Household Income per Capita (SGD)") +
xlim(0, 10000) + annotate("text", x = mean_income_sg - 200, y = 2e-04, label = paste("Mean = S$",
round(mean_income_sg, 2))) + geom_vline(aes(xintercept = mean_income_sg), linetype = "dashed",
size = 1) + theme_modern() + ggtitle("Singapore Sample") + scale_fill_brewer(palette = "Dark2")
# UK Income
mean_income_uk <- df_uk %>% filter(Student == "No") %>% filter(!is.na(Education_Achieved)) %>%
filter(!is.na(Income)) %>% summarise(mean = mean(Income))
mean_income_uk <- mean_income_uk$mean
p_income_uk <- df_uk %>% filter(Student == "No") %>% filter(!is.na(Education_Achieved)) %>%
filter(!is.na(Income)) %>% ggplot(aes(x = Income, color = Education_Achieved)) +
geom_density(size = 1, alpha = 0.3) + labs(colour = "Education Level") + xlab("Monthly Household Income per Capita (GBP converted to SGD)") +
xlim(0, 20000) + annotate("text", x = mean_income_uk - 200, y = 2e-04, label = paste("Mean = S$",
round(mean_income_uk, 2))) + geom_vline(aes(xintercept = mean_income_uk), linetype = "dashed",
size = 1) + theme_modern() + ggtitle("UK Sample") + scale_fill_brewer(palette = "Dark2")
p_income_sg + p_income_uk
Age
colors_sguk <- c(SG = "#E91E63", UK = "#2979FF")
age_plot <- bind_rows(df_sg, df_uk) %>% ggplot(aes(x = Age)) + geom_histogram(aes(color = Dataset,
fill = Dataset), position = "identity", binwidth = 1, alpha = 0.4) + scale_fill_manual(values = colors_sguk) +
scale_color_manual(values = colors_sguk) + xlab("Age (years)") + theme_modern()
ggsave("figures/age.png", age_plot, height = figwidth, width = figwidth * 1.5, dpi = 600)
# Correlation between survey completion duration and age df_sg %>%
# ggplot(aes(x=Age, y=Duration)) + geom_point() + geom_smooth(method = 'lm',
# alpha = 0.2) + ggtitle(paste('r =', insight::format_value(cor.test(df_sg$Age,
# df_sg$Duration)$estimate), ', p =', insight::format_value(cor.test(df_sg$Age,
# df_sg$Duration)$p.value))) + ylab('Duration of Survey Completion (min)') +
# xlab('Age (years)') + theme_modern()Religion
# SG Religion
p_religion_sg <- df_sg %>% filter(!is.na(Religion_Engagement)) %>% filter(!is.na(Religion_Type)) %>%
filter(!is.na(Religion_Faith)) %>% ggplot(aes(x = Religion_Engagement, color = Religion_Type)) +
labs(colour = "Religion") + xlab("Religious Engagement") + geom_density(size = 1,
alpha = 0.5) + scale_fill_brewer(palette = "Accent") + ggtitle("Singapore Sample") +
theme_modern()
# UK Religion
p_religion_uk <- df_uk %>% filter(!is.na(Religion_Engagement)) %>% filter(!is.na(Religion_Type)) %>%
filter(!is.na(Religion_Faith)) %>% ggplot(aes(x = Religion_Engagement, color = Religion_Type)) +
labs(colour = "Religion") + xlab("Religious Engagement") + geom_density(size = 1,
alpha = 0.5) + scale_fill_brewer(palette = "Accent") + ggtitle("UK Sample") +
theme_modern()
p_religion_sg + p_religion_uk
# Relationship between religious engagement and faith
p_religion2_sg <- df_sg %>% filter(!is.na(Religion_Engagement)) %>% filter(!is.na(Religion_Faith)) %>%
filter(!is.na(Religion_Type)) %>% ggplot(aes(x = Religion_Faith, y = Religion_Engagement,
colour = Religion_Type, fill = Religion_Type)) + geom_jitter() + geom_smooth(method = "lm",
alpha = 0.2) + ggtitle(paste("Singapore Sample, r =", insight::format_value(cor.test(df_sg$Religion_Engagement,
df_sg$Religion_Faith)$estimate), ", p =", insight::format_value(cor.test(df_sg$Religion_Engagement,
df_sg$Religion_Faith)$p.value))) + theme_modern()
p_religion2_uk <- df_uk %>% filter(!is.na(Religion_Engagement)) %>% filter(!is.na(Religion_Faith)) %>%
filter(!is.na(Religion_Type)) %>% ggplot(aes(x = Religion_Faith, y = Religion_Engagement,
colour = Religion_Type, fill = Religion_Type)) + geom_jitter() + geom_smooth(method = "lm",
alpha = 0.2) + ggtitle(paste("UK Sample, r =", insight::format_value(cor.test(df_uk$Religion_Engagement,
df_uk$Religion_Faith)$estimate), ", p =", insight::format_value(cor.test(df_uk$Religion_Engagement,
df_uk$Religion_Faith)$p.value))) + theme_modern()
p_religion2_sg/p_religion2_uk
# Overall religiosity across countries
p_religion_engagement <- bind_rows(df_sg, df_uk) %>% ggplot(aes(x = Religion_Engagement)) +
geom_density(aes(color = Dataset, fill = Dataset), position = "identity", alpha = 0.4) +
scale_fill_manual(values = colors_sguk) + scale_color_manual(values = colors_sguk) +
xlab("Religion Engagement") + theme_modern()
p_religion_faith <- bind_rows(df_sg, df_uk) %>% ggplot(aes(x = Religion_Faith)) +
geom_density(aes(color = Dataset, fill = Dataset), position = "identity", alpha = 0.4) +
scale_fill_manual(values = colors_sguk) + scale_color_manual(values = colors_sguk) +
xlab("Religion Faith") + theme_modern()
religion_plot <- p_religion_engagement + p_religion_faith
ggsave("figures/religion.png", religion_plot, height = figwidth, width = figwidth *
1.5, dpi = 600)
# Combine into one religion index
df_sg <- df_sg %>% mutate(Religion = (Religion_Engagement + Religion_Faith)/2)
df_uk <- df_uk %>% mutate(Religion = (Religion_Engagement + Religion_Faith)/2)
# Summary
ggstatsplot::grouped_ggbetweenstats(data = melt(bind_rows(df_sg, df_uk), measure.vars = c("Religion_Engagement",
"Religion_Faith")), x = Dataset, y = value, plot.type = "boxviolin", grouping.var = variable,
mean.ci = TRUE, outlier.tagging = FALSE, xlab = "Sample", ylab = "Value", title.prefix = NULL,
notch = FALSE, bf.message = FALSE, results.subtitle = FALSE, title.text = "Religiosity Differences across Singapore and UK")
COVID-related Measures
Precautionary Measures
# Correlation between Compliance and Belief
p_measurescorr_sg <- dataframe_wrangle(df_sg, dataset = "Singapore Sample")
p_measurescorr_uk <- dataframe_wrangle(df_uk, dataset = "UK Sample")
p_measurescorr_sg/p_measurescorr_uk
# Combine into one precuationery measures engagement index per type
df_sg <- df_sg %>% mutate(Measures_Distancing = (Belief_Distancing + Compliance_Distancing)/2,
Measures_WashingHands = (Belief_WashHands + Compliance_WashHands)/2, Measures_StayHome = (Belief_StayHome +
Compliance_StayHome)/2, Measures_TouchFace = (Belief_Face + Compliance_Face)/2,
Measures_WearMask = (Belief_Mask + Compliance_Mask)/2) %>% select(-starts_with("Belief"),
-starts_with("Compliance"))
df_uk <- df_uk %>% mutate(Measures_Distancing = (Belief_Distancing + Compliance_Distancing)/2,
Measures_WashingHands = (Belief_WashHands + Compliance_WashHands)/2, Measures_StayHome = (Belief_StayHome +
Compliance_StayHome)/2, Measures_TouchFace = (Belief_Face + Compliance_Face)/2,
Measures_WearMask = (Belief_Mask + Compliance_Mask)/2) %>% select(-starts_with("Belief"),
-starts_with("Compliance"))PCA for COVID Measures
df_combined <- bind_rows(df_sg, df_uk)
# # Report full demographics
df_combined %>% select(Dataset, Age, Gender, Student, Education, starts_with("Religion"),
Ethnicity, COVID_Diagnosis) %>% report(levels_percentage = TRUE, missing_percentage = TRUE,
n_entries = 10)> The data contains 500 observations of the following variables:
> - Dataset: 2 levels, namely SG (n = 336, 67.20%) and UK (n = 164, 32.80%)
> - Age: n = 500, Mean = 27.82, SD = 10.30, Median = 24.00, MAD = 5.93, range: [18, 68], Skewness = 1.70, Kurtosis = 2.40, 0% missing
> - Gender: 2 levels, namely Female (n = 323, 64.60%) and Male (n = 177, 35.40%)
> - Student: 2 entries, such as Yes (57.40%%); No (42.60%%); NA; NA; NA; NA; NA; NA; NA; NA(0.00% missing)
> - Education: n = 500, Mean = 2.56, SD = 2.06, Median = , MAD = 2.97, range: [-2, 10], Skewness = 0.38, Kurtosis = 1.73, 1.40% missing
> - Religion_Type: 7 entries, such as Other (26.40%%); Christianity (26.00%%); No religion (18.80%%); Buddhism (18.40%%); Islam (4.40%%); Hinduism (3.00%%); Taoism (3.00%%); NA; NA; NA(0.00% missing)
> - Religion_Faith: n = 500, Mean = 3.64, SD = 3.21, Median = , MAD = 4.45, range: [0, 10], Skewness = 0.30, Kurtosis = -1.34, 1.80% missing
> - Religion_Engagement: n = 500, Mean = 2.88, SD = 3.13, Median = , MAD = 2.97, range: [0, 10], Skewness = 0.75, Kurtosis = -0.81, 2.20% missing
> - Religion: n = 500, Mean = 3.26, SD = 3.06, Median = , MAD = 3.71, range: [0, 10], Skewness = 0.52, Kurtosis = -1.08, 2.20% missing
> - Ethnicity: 7 entries, such as Chinese (57.40%%); White (24.80%%); Other (8.40%%); Asian (3.60%%); Indian (3.00%%); Malay (2.40%%); Spain and Latin America (0.40%%); NA; NA; NA(0.00% missing)
> - COVID_Diagnosis: 4 entries, such as I have not been tested and I do not think I have COVID-19. (87.00%%); I have been tested but did not have COVID-19. (8.00%%); I have not been tested, but I think I have COVID-19. (3.00%%); I have been tested and diagnosed with COVID-19. (2.00%%); NA; NA; NA; NA; NA; NA(0.00% missing)df_sg %>% select(Ethnicity) %>% report(levels_percentage = TRUE, missing_percentage = TRUE,
n_entries = 10)> The data contains 336 observations of the following variables:
> - Ethnicity: 4 entries, such as Chinese (85.42%%); Other (6.55%%); Indian (4.46%%); Malay (3.57%%); NA; NA; NA; NA; NA; NA(0.00% missing)df_uk %>% select(Ethnicity) %>% report(levels_percentage = TRUE, missing_percentage = TRUE,
n_entries = 10)> The data contains 164 observations of the following variables:
> - Ethnicity: 4 entries, such as White (75.61%%); Other (12.20%%); Asian (10.98%%); Spain and Latin America (1.22%%); NA; NA; NA; NA; NA; NA(0.00% missing)df_measure <- df_combined %>% select(starts_with("Measures"))
# Check Factor Structure
parameters::check_factorstructure(df_measure)> # Is the data suitable for Factor Analysis?
>
> - KMO: The Kaiser, Meyer, Olkin (KMO) measure of sampling adequacy suggests that data seems appropriate for factor analysis (KMO = 0.73).
> - Sphericity: Bartlett's test of sphericity suggests that there is sufficient significant correlation in the data for factor analysis (Chisq(10) = 647.11, p < .001).cor <- correlation::correlation(df_measure)
# How many factor
parameters::n_components(df_measure, cor = cor, rotation = "promax")| n_Factors | Method | Family |
|---|---|---|
| 1 | Bentler | Bentler |
| 1 | Optimal coordinates | Scree |
| 1 | Acceleration factor | Scree |
| 1 | Parallel analysis | Scree |
| 1 | Kaiser criterion | Scree |
| 1 | SE Scree | Scree_SE |
| 1 | R2 | Scree_SE |
| 1 | Velicer’s MAP | Velicers_MAP |
| 4 | Bartlett | Barlett |
| 4 | Anderson | Barlett |
| 4 | Lawley | Barlett |
| 4 | VSS complexity 1 | VSS |
| 4 | VSS complexity 2 | VSS |
pca_measure <- principal_components(df_measure, n = 1, rotation = "promax", threshold = "max",
sort = TRUE)
df_combined$Measures_G <- predict(pca_measure)$PC1Government Opinions
Beliefs about the Singapore government are largely positive, with individuals generally trusting that the government is able to handle the situation, believing that they have been effective and transparent. On the other hand, beliefs about the UK government are less positive.
# p_gov_sg <- descriptive_statistics(df_sg, 'Gov', dataset='Singapore Sample')
# p_gov_uk <- descriptive_statistics(df_uk, 'Gov', dataset='UK Sample') p_gov_sg
# + p_gov_ukPCA for Government opinion
df_gov <- df_combined %>% select(starts_with("Gov"))
# Check Factor Structure
parameters::check_factorstructure(df_gov)> # Is the data suitable for Factor Analysis?
>
> - KMO: The Kaiser, Meyer, Olkin (KMO) measure of sampling adequacy suggests that data seems appropriate for factor analysis (KMO = 0.71).
> - Sphericity: Bartlett's test of sphericity suggests that there is sufficient significant correlation in the data for factor analysis (Chisq(3) = 1200.11, p < .001).cor <- correlation::correlation(df_gov)
# How many factor
parameters::n_components(df_gov, cor = cor, rotation = "promax")| n_Factors | Method | Family |
|---|---|---|
| 0 | R2 | Scree_SE |
| 1 | Optimal coordinates | Scree |
| 1 | Acceleration factor | Scree |
| 1 | Parallel analysis | Scree |
| 1 | Kaiser criterion | Scree |
| 1 | SE Scree | Scree_SE |
| 2 | Bartlett | Barlett |
| 2 | Anderson | Barlett |
| 2 | Lawley | Barlett |
| 3 | Bentler | Bentler |
pca_gov <- principal_components(df_gov, n = 1, rotation = "promax", threshold = "max",
sort = TRUE)
df_combined$Gov_G <- predict(pca_gov)$PC1Personal Impact
# Rescale COVID impact
df_sg[stringr::str_detect(names(df_sg), "COVID_")][2:6] <- effectsize::change_scale(select(df_sg[stringr::str_detect(names(df_sg),
"COVID_")], -COVID_Diagnosis), from = c(0, 6), to = c(-3, 3))
df_uk[stringr::str_detect(names(df_uk), "COVID_")][2:6] <- effectsize::change_scale(select(df_uk[stringr::str_detect(names(df_uk),
"COVID_")], -COVID_Diagnosis), from = c(0, 6), to = c(-3, 3))
# p_impact_sg <- descriptive_statistics(select(df_sg, -COVID_Diagnosis), 'COVID',
# dataset='Singapore Sample') p_impact_uk <- descriptive_statistics(select(df_uk,
# -COVID_Diagnosis), 'COVID', dataset='UK Sample') p_impact_sg + p_impact_ukPCA for Personal Impact
# om_impact <- omega(df_combined, filter = 'COVID_', except = 'COVID_Diagnosis',
# rotation_method='promax') df_combined$Impact_G <- om_impact$scores[,1]
df_impact <- df_combined %>% select(starts_with("COVID_")) %>% select(-COVID_Diagnosis)
# Check Factor Structure
parameters::check_factorstructure(df_impact)> # Is the data suitable for Factor Analysis?
>
> - KMO: The Kaiser, Meyer, Olkin (KMO) measure of sampling adequacy suggests that data seems appropriate for factor analysis (KMO = 0.73).
> - Sphericity: Bartlett's test of sphericity suggests that there is sufficient significant correlation in the data for factor analysis (Chisq(10) = 340.55, p < .001).cor <- correlation::correlation(df_impact)
# How many factor
parameters::n_components(df_impact, cor = cor, rotation = "promax")| n_Factors | Method | Family |
|---|---|---|
| 0 | R2 | Scree_SE |
| 1 | Optimal coordinates | Scree |
| 1 | Acceleration factor | Scree |
| 1 | Parallel analysis | Scree |
| 1 | Kaiser criterion | Scree |
| 1 | SE Scree | Scree_SE |
| 1 | Velicer’s MAP | Velicers_MAP |
| 3 | Bartlett | Barlett |
| 3 | Anderson | Barlett |
| 3 | VSS complexity 1 | VSS |
| 4 | Lawley | Barlett |
| 4 | VSS complexity 2 | VSS |
| 5 | Bentler | Bentler |
pca_impact <- principal_components(df_impact, n = 1, rotation = "promax", threshold = "max",
sort = TRUE)
df_combined$Impact_G <- predict(pca_impact)$PC1News Consumption Patterns
# News Frequency
p_freq_sg <- df_sg %>% select(starts_with("Frequency_"), "Participant") %>% melt(id = "Participant") %>%
arrange(Participant) %>% mutate(variable = str_remove(variable, "Frequency_")) %>%
rename(News = variable, Frequency = value) %>% mutate(Frequency = ifelse(Frequency ==
"Once a day", "Once", ifelse(Frequency == "Twice a day", "Twice", ifelse(Frequency ==
"Thrice a day", "Thrice", "> Thrice")))) %>% mutate(Frequency = factor(Frequency,
levels = c("Once", "Twice", "Thrice", "> Thrice"))) %>% ggplot(aes(x = Frequency,
fill = News)) + geom_bar(position = "dodge") + xlab("News Frequency per day") +
ggtitle("Singapore Sample") + theme_modern()
p_freq_uk <- df_uk %>% select(starts_with("Frequency_"), "Participant") %>% melt(id = "Participant") %>%
arrange(Participant) %>% mutate(variable = str_remove(variable, "Frequency_")) %>%
rename(News = variable, Frequency = value) %>% mutate(Frequency = ifelse(Frequency ==
"Once a day", "Once", ifelse(Frequency == "Twice a day", "Twice", ifelse(Frequency ==
"Thrice a day", "Thrice", "> Thrice")))) %>% mutate(Frequency = factor(Frequency,
levels = c("Once", "Twice", "Thrice", "> Thrice"))) %>% filter(!is.na(Frequency)) %>%
ggplot(aes(x = Frequency, fill = News)) + geom_bar(position = "dodge") + xlab("News Frequency per day") +
ggtitle("UK Sample") + theme_modern()
p_freq_sg + p_freq_uk
# Source of News Outlets
descriptive_statistics(df_sg, "Source", "Singapore Sample")> The data contains 336 observations of the following variables:
> - Source_Newspaper: n = 336, Mean = 1.48, SD = 1.88, Median = 1.00, MAD = 1.48, range: [0, 6], Skewness = 1.08, Kurtosis = -0.10, 0% missing
> - Source_SocialNetworks: n = 336, Mean = 4.63, SD = 1.64, Median = 5.00, MAD = 1.48, range: [0, 6], Skewness = -1.27, Kurtosis = 0.87, 0% missing
> - Source_OfficialSites: n = 336, Mean = 4.72, SD = 1.56, Median = 5.00, MAD = 1.48, range: [0, 6], Skewness = -1.45, Kurtosis = 1.61, 0% missing
> - Source_SharedLinks: n = 336, Mean = 2.93, SD = 2.11, Median = 3.00, MAD = 2.97, range: [0, 6], Skewness = -0.03, Kurtosis = -1.39, 0% missingp_source_sg <- descriptive_plot(df_sg, "Source", "Singapore Sample")
descriptive_statistics(df_uk, "Source", "UK Sample")> The data contains 164 observations of the following variables:
> - Source_Newspaper: n = 164, Mean = 0.82, SD = 1.44, Median = , MAD = 0.00, range: [0, 6], Skewness = 1.86, Kurtosis = 2.34, 0.61% missing
> - Source_SocialNetworks: n = 164, Mean = 4.11, SD = 1.88, Median = 5.00, MAD = 1.48, range: [0, 6], Skewness = -0.80, Kurtosis = -0.55, 0% missing
> - Source_OfficialSites: n = 164, Mean = 4.71, SD = 1.55, Median = 5.00, MAD = 1.48, range: [0, 6], Skewness = -1.56, Kurtosis = 1.90, 0% missing
> - Source_SharedLinks: n = 164, Mean = 2.12, SD = 1.92, Median = 2.00, MAD = 2.97, range: [0, 6], Skewness = 0.55, Kurtosis = -0.98, 0% missingp_source_uk <- descriptive_plot(df_uk, "Source", "UK Sample")
p_source_sg + p_source_uk
Participants in both Singapore and UK samples are more avid followers of news on social media networks and official sites as compared to reading the newspapers (visiting shared links being of moderate frequency). Their frequency of consuming COVID-specific news and consuming general news are also similar.
Correlation of Frequency of Reading News (Generally & from different Sources)
df_combined %>% select(Frequency_COVID, starts_with("Sourc")) %>% correlation::correlation()| Parameter1 | Parameter2 | r | CI_low | CI_high | t | df | p | Method | n_Obs |
|---|---|---|---|---|---|---|---|---|---|
| Source_Newspaper | Source_SocialNetworks | -0.06 | -0.15 | 0.03 | -1.34 | 497 | 0.54 | Pearson | 499 |
| Source_Newspaper | Source_OfficialSites | -0.02 | -0.11 | 0.07 | -0.43 | 497 | 0.89 | Pearson | 499 |
| Source_Newspaper | Source_SharedLinks | 0.11 | 0.02 | 0.19 | 2.36 | 497 | 0.09 | Pearson | 499 |
| Source_SocialNetworks | Source_OfficialSites | -0.08 | -0.17 | 0.01 | -1.79 | 498 | 0.30 | Pearson | 500 |
| Source_SocialNetworks | Source_SharedLinks | 0.31 | 0.22 | 0.38 | 7.19 | 498 | 0.00 | Pearson | 500 |
| Source_OfficialSites | Source_SharedLinks | -0.03 | -0.12 | 0.05 | -0.76 | 498 | 0.89 | Pearson | 500 |
Data Processing for News Consumption
df_combined <- df_combined %>% mutate_at(vars(starts_with("Frequency_")), function(x) ifelse(x ==
"More than thrice a day", 4, ifelse(x == "Thrice a day", 3, ifelse(x == "Twice a day",
2, ifelse(x == "Once a day", 1, NA)))))
# cor <- correlation::correlation(df_combined[str_detect(names(df_combined),
# 'Frequency_')])Results
Descriptive Statistics
Conspiracist Mentality (CMQ)
descriptive_statistics(df_sg, "CMQ", dataset = "Singapore Sample")> The data contains 336 observations of the following variables:
> - CMQ_1: n = 336, Mean = 7.95, SD = 1.85, Median = 8.00, MAD = 1.48, range: [0, 10], Skewness = -1.07, Kurtosis = 1.40, 0% missing
> - CMQ_2: n = 336, Mean = 7.79, SD = 1.91, Median = 8.00, MAD = 1.48, range: [0, 10], Skewness = -0.91, Kurtosis = 0.99, 0% missing
> - CMQ_3: n = 336, Mean = 6.48, SD = 2.27, Median = 7.00, MAD = 2.97, range: [0, 10], Skewness = -0.31, Kurtosis = -0.72, 0% missing
> - CMQ_4: n = 336, Mean = 5.27, SD = 2.66, Median = 5.00, MAD = 2.97, range: [0, 10], Skewness = -0.02, Kurtosis = -0.90, 0% missing
> - CMQ_5: n = 336, Mean = 5.71, SD = 2.73, Median = 6.00, MAD = 2.97, range: [0, 10], Skewness = -0.23, Kurtosis = -0.93, 0% missing
> - CMQ_General: n = 336, Mean = 6.64, SD = 1.64, Median = 6.60, MAD = 1.78, range: [2.60, 10], Skewness = -0.06, Kurtosis = -0.56, 0% missingdescriptive_statistics(df_uk, "CMQ", dataset = "UK Sample")> The data contains 164 observations of the following variables:
> - CMQ_1: n = 164, Mean = 7.60, SD = 2.14, Median = 8.00, MAD = 1.48, range: [0, 10], Skewness = -1.13, Kurtosis = 1.51, 0% missing
> - CMQ_2: n = 164, Mean = 7.93, SD = 1.90, Median = 8.00, MAD = 1.48, range: [1, 10], Skewness = -1.17, Kurtosis = 1.69, 0% missing
> - CMQ_3: n = 164, Mean = 5.72, SD = 2.41, Median = , MAD = 2.97, range: [0, 10], Skewness = -0.13, Kurtosis = -0.74, 1.22% missing
> - CMQ_4: n = 164, Mean = 5.07, SD = 2.52, Median = , MAD = 2.97, range: [0, 10], Skewness = -0.03, Kurtosis = -0.80, 1.22% missing
> - CMQ_5: n = 164, Mean = 5.90, SD = 2.66, Median = , MAD = 2.97, range: [0, 10], Skewness = -0.27, Kurtosis = -0.73, 0.61% missing
> - CMQ_General: n = 164, Mean = 6.45, SD = 1.78, Median = , MAD = 1.78, range: [0.80, 10], Skewness = -0.22, Kurtosis = -0.31, 2.44% missingp_CMQ_sg <- descriptive_plot(df_sg, "CMQ", dataset = "Singapore Sample")
p_CMQ_uk <- descriptive_plot(df_uk, "CMQ", dataset = "UK Sample")
p_CMQ_sg + p_CMQ_uk
Paranormal Beliefs (PBS)
descriptive_statistics(df_sg, "PBS", dataset = "Singapore Sample")> The data contains 336 observations of the following variables:
> - PBS_1: n = 336, Mean = 3.53, SD = 1.96, Median = 4.00, MAD = 1.48, range: [0, 6], Skewness = -0.39, Kurtosis = -1.02, 0% missing
> - PBS_2: n = 336, Mean = 1.53, SD = 1.76, Median = 1.00, MAD = 1.48, range: [0, 6], Skewness = 0.91, Kurtosis = -0.40, 0% missing
> - PBS_3: n = 336, Mean = 2.21, SD = 1.91, Median = 2.00, MAD = 2.97, range: [0, 6], Skewness = 0.29, Kurtosis = -1.22, 0% missing
> - PBS_4: n = 336, Mean = 1.45, SD = 1.48, Median = 1.00, MAD = 1.48, range: [0, 6], Skewness = 0.59, Kurtosis = -0.77, 0% missing
> - PBS_5: n = 336, Mean = 3.07, SD = 2.09, Median = 3.00, MAD = 2.97, range: [0, 6], Skewness = -0.06, Kurtosis = -1.26, 0% missing
> - PBS_6: n = 336, Mean = 1.74, SD = 1.80, Median = 1.00, MAD = 1.48, range: [0, 6], Skewness = 0.66, Kurtosis = -0.78, 0% missing
> - PBS_7: n = 336, Mean = 2.40, SD = 1.93, Median = 2.00, MAD = 2.97, range: [0, 6], Skewness = 0.20, Kurtosis = -1.20, 0% missing
> - PBS_8: n = 336, Mean = 1.29, SD = 1.47, Median = 1.00, MAD = 1.48, range: [0, 6], Skewness = 0.85, Kurtosis = -0.38, 0% missing
> - PBS_9: n = 336, Mean = 3.42, SD = 2.13, Median = 3.00, MAD = 2.97, range: [0, 6], Skewness = -0.23, Kurtosis = -1.25, 0% missing
> - PBS_10: n = 336, Mean = 1.54, SD = 1.75, Median = 1.00, MAD = 1.48, range: [0, 6], Skewness = 0.94, Kurtosis = -0.14, 0% missing
> - PBS_11: n = 336, Mean = 2.50, SD = 1.98, Median = 3.00, MAD = 2.97, range: [0, 6], Skewness = 0.13, Kurtosis = -1.17, 0% missing
> - PBS_12: n = 336, Mean = 2.15, SD = 1.81, Median = 2.00, MAD = 2.97, range: [0, 6], Skewness = 0.18, Kurtosis = -1.29, 0% missing
> - PBS_13: n = 336, Mean = 3.56, SD = 2.05, Median = 4.00, MAD = 2.97, range: [0, 6], Skewness = -0.36, Kurtosis = -1.08, 0% missing
> - PBS_14: n = 336, Mean = 3.15, SD = 1.80, Median = 3.00, MAD = 1.48, range: [0, 6], Skewness = -0.26, Kurtosis = -0.91, 0% missing
> - PBS_15: n = 336, Mean = 2.07, SD = 1.86, Median = 2.00, MAD = 2.97, range: [0, 6], Skewness = 0.35, Kurtosis = -1.08, 0% missing
> - PBS_16: n = 336, Mean = 2.72, SD = 1.83, Median = 3.00, MAD = 1.48, range: [0, 6], Skewness = -0.15, Kurtosis = -1.17, 0% missing
> - PBS_ReligiousBeliefs: n = 336, Mean = 3.39, SD = 1.79, Median = 3.50, MAD = 2.22, range: [0, 6], Skewness = -0.20, Kurtosis = -1.02, 0% missing
> - PBS_Precognition: n = 336, Mean = 1.90, SD = 1.37, Median = 2.00, MAD = 1.67, range: [0, 5.50], Skewness = 0.19, Kurtosis = -1.00, 0% missing
> - PBS_Psi: n = 336, Mean = 1.99, SD = 1.36, Median = 1.75, MAD = 1.48, range: [0, 6], Skewness = 0.49, Kurtosis = -0.33, 0% missing
> - PBS_Spiritualism: n = 336, Mean = 2.29, SD = 1.58, Median = 2.50, MAD = 1.85, range: [0, 5.75], Skewness = 0.15, Kurtosis = -0.96, 0% missing
> - PBS_General: n = 336, Mean = 2.40, SD = 1.21, Median = 2.44, MAD = 1.39, range: [0, 5.38], Skewness = 4.54e-03, Kurtosis = -0.70, 0% missingdescriptive_statistics(df_uk, "PBS", dataset = "UK Sample")> The data contains 164 observations of the following variables:
> - PBS_1: n = 164, Mean = 2.67, SD = 1.88, Median = , MAD = 2.97, range: [0, 6], Skewness = 0.05, Kurtosis = -1.23, 0.61% missing
> - PBS_2: n = 164, Mean = 0.51, SD = 1.05, Median = 0.00, MAD = 0.00, range: [0, 6], Skewness = 2.61, Kurtosis = 7.30, 0% missing
> - PBS_3: n = 164, Mean = 1.35, SD = 1.59, Median = 1.00, MAD = 1.48, range: [0, 6], Skewness = 1.18, Kurtosis = 0.33, 0% missing
> - PBS_4: n = 164, Mean = 1.26, SD = 1.53, Median = 1.00, MAD = 1.48, range: [0, 6], Skewness = 1.19, Kurtosis = 0.53, 0% missing
> - PBS_5: n = 164, Mean = 1.47, SD = 1.80, Median = , MAD = 1.48, range: [0, 6], Skewness = 1.16, Kurtosis = 0.17, 0.61% missing
> - PBS_6: n = 164, Mean = 0.70, SD = 1.21, Median = 0.00, MAD = 0.00, range: [0, 6], Skewness = 2.25, Kurtosis = 5.33, 0% missing
> - PBS_7: n = 164, Mean = 1.49, SD = 1.64, Median = 1.00, MAD = 1.48, range: [0, 6], Skewness = 0.89, Kurtosis = -0.31, 0% missing
> - PBS_8: n = 164, Mean = 1.09, SD = 1.51, Median = 0.00, MAD = 0.00, range: [0, 6], Skewness = 1.48, Kurtosis = 1.38, 0% missing
> - PBS_9: n = 164, Mean = 1.68, SD = 1.91, Median = 1.00, MAD = 1.48, range: [0, 6], Skewness = 1.00, Kurtosis = -0.24, 0% missing
> - PBS_10: n = 164, Mean = 0.54, SD = 1.04, Median = 0.00, MAD = 0.00, range: [0, 6], Skewness = 2.44, Kurtosis = 6.42, 0% missing
> - PBS_11: n = 164, Mean = 1.91, SD = 1.73, Median = 1.00, MAD = 1.48, range: [0, 6], Skewness = 0.52, Kurtosis = -1.01, 0% missing
> - PBS_12: n = 164, Mean = 1.66, SD = 1.77, Median = , MAD = 1.48, range: [0, 6], Skewness = 0.73, Kurtosis = -0.75, 0.61% missing
> - PBS_13: n = 164, Mean = 1.59, SD = 1.86, Median = 1.00, MAD = 1.48, range: [0, 6], Skewness = 1.09, Kurtosis = 0.09, 0% missing
> - PBS_14: n = 164, Mean = 2.65, SD = 2.09, Median = 2.00, MAD = 2.97, range: [0, 6], Skewness = 0.07, Kurtosis = -1.46, 0% missing
> - PBS_15: n = 164, Mean = 1.67, SD = 1.78, Median = , MAD = 1.48, range: [0, 6], Skewness = 0.71, Kurtosis = -0.77, 0.61% missing
> - PBS_16: n = 164, Mean = 1.91, SD = 1.77, Median = , MAD = 2.97, range: [0, 6], Skewness = 0.46, Kurtosis = -1.07, 0.61% missing
> - PBS_ReligiousBeliefs: n = 164, Mean = 1.85, SD = 1.57, Median = , MAD = 1.48, range: [0, 6], Skewness = 0.87, Kurtosis = -0.07, 1.22% missing
> - PBS_Precognition: n = 164, Mean = 1.48, SD = 1.41, Median = , MAD = 1.48, range: [0, 5.50], Skewness = 0.93, Kurtosis = 0.06, 0.61% missing
> - PBS_Psi: n = 164, Mean = 1.10, SD = 0.99, Median = 1.00, MAD = 1.11, range: [0, 5.25], Skewness = 1.20, Kurtosis = 1.96, 0% missing
> - PBS_Spiritualism: n = 164, Mean = 1.61, SD = 1.40, Median = , MAD = 1.48, range: [0, 5.50], Skewness = 0.69, Kurtosis = -0.45, 0.61% missing
> - PBS_General: n = 164, Mean = 1.51, SD = 1.08, Median = , MAD = 1.11, range: [0, 5.12], Skewness = 0.79, Kurtosis = 0.18, 1.22% missingp_PBS_sg <- descriptive_plot(df_sg, "PBS", dataset = "Singapore Sample")
p_PBS_uk <- descriptive_plot(df_uk, "PBS", dataset = "UK Sample")
p_PBS_sg + p_PBS_uk
Paranoia (GPTS)
descriptive_statistics(df_sg, "GPTS", dataset = "Singapore Sample")> The data contains 336 observations of the following variables:
> - GPTS_1: n = 336, Mean = 1.13, SD = 1.19, Median = 1.00, MAD = 1.48, range: [0, 4], Skewness = 0.88, Kurtosis = -0.27, 0% missing
> - GPTS_2: n = 336, Mean = 1.21, SD = 1.14, Median = 1.00, MAD = 1.48, range: [0, 4], Skewness = 0.75, Kurtosis = -0.36, 0% missing
> - GPTS_3: n = 336, Mean = 1.74, SD = 1.36, Median = 1.50, MAD = 2.22, range: [0, 4], Skewness = 0.18, Kurtosis = -1.30, 0% missing
> - GPTS_4: n = 336, Mean = 1.44, SD = 1.31, Median = 1.00, MAD = 1.48, range: [0, 4], Skewness = 0.51, Kurtosis = -0.98, 0% missing
> - GPTS_5: n = 336, Mean = 1.10, SD = 1.21, Median = 1.00, MAD = 1.48, range: [0, 4], Skewness = 0.96, Kurtosis = -0.09, 0% missing
> - GPTS_6: n = 336, Mean = 1.01, SD = 1.10, Median = 1.00, MAD = 1.48, range: [0, 4], Skewness = 0.97, Kurtosis = 0.08, 0% missing
> - GPTS_7: n = 336, Mean = 2.58, SD = 1.32, Median = 3.00, MAD = 1.48, range: [0, 4], Skewness = -0.70, Kurtosis = -0.70, 0% missing
> - GPTS_8: n = 336, Mean = 1.88, SD = 1.40, Median = 2.00, MAD = 1.48, range: [0, 4], Skewness = 0.01, Kurtosis = -1.39, 0% missing
> - GPTS_9: n = 336, Mean = 1.56, SD = 1.32, Median = 1.00, MAD = 1.48, range: [0, 4], Skewness = 0.38, Kurtosis = -1.10, 0% missing
> - GPTS_10: n = 336, Mean = 0.71, SD = 1.00, Median = 0.00, MAD = 0.00, range: [0, 4], Skewness = 1.45, Kurtosis = 1.33, 0% missing
> - GPTS_11: n = 336, Mean = 1.24, SD = 1.27, Median = 1.00, MAD = 1.48, range: [0, 4], Skewness = 0.66, Kurtosis = -0.82, 0% missing
> - GPTS_12: n = 336, Mean = 0.58, SD = 0.96, Median = 0.00, MAD = 0.00, range: [0, 4], Skewness = 1.78, Kurtosis = 2.59, 0% missing
> - GPTS_13: n = 336, Mean = 0.67, SD = 0.99, Median = 0.00, MAD = 0.00, range: [0, 4], Skewness = 1.58, Kurtosis = 1.84, 0% missing
> - GPTS_14: n = 336, Mean = 0.74, SD = 1.04, Median = 0.00, MAD = 0.00, range: [0, 4], Skewness = 1.39, Kurtosis = 1.01, 0% missing
> - GPTS_15: n = 336, Mean = 0.72, SD = 1.04, Median = 0.00, MAD = 0.00, range: [0, 4], Skewness = 1.57, Kurtosis = 1.80, 0% missing
> - GPTS_16: n = 336, Mean = 0.95, SD = 1.21, Median = 0.00, MAD = 0.00, range: [0, 4], Skewness = 1.10, Kurtosis = -3.08e-04, 0% missing
> - GPTS_17: n = 336, Mean = 1.06, SD = 1.29, Median = 1.00, MAD = 1.48, range: [0, 4], Skewness = 1.01, Kurtosis = -0.24, 0% missing
> - GPTS_18: n = 336, Mean = 1.19, SD = 1.33, Median = 1.00, MAD = 1.48, range: [0, 4], Skewness = 0.72, Kurtosis = -0.84, 0% missing
> - GPTS_Reference: n = 336, Mean = 12.08, SD = 7.23, Median = 12.00, MAD = 7.41, range: [0, 32], Skewness = 0.29, Kurtosis = -0.48, 0% missing
> - GPTS_Persecution: n = 336, Mean = 9.41, SD = 8.61, Median = 8.00, MAD = 9.64, range: [0, 40], Skewness = 0.88, Kurtosis = 0.22, 0% missing
> - GPTS_General: n = 336, Mean = 10.75, SD = 7.35, Median = 10.00, MAD = 7.78, range: [0, 36], Skewness = 0.64, Kurtosis = 0.07, 0% missingdescriptive_statistics(df_uk, "GPTS", dataset = "UK Sample")> The data contains 164 observations of the following variables:
> - GPTS_1: n = 164, Mean = 1.60, SD = 1.35, Median = , MAD = 1.48, range: [0, 4], Skewness = 0.30, Kurtosis = -1.24, 0.61% missing
> - GPTS_2: n = 164, Mean = 1.21, SD = 1.14, Median = , MAD = 1.48, range: [0, 4], Skewness = 0.78, Kurtosis = -0.37, 0.61% missing
> - GPTS_3: n = 164, Mean = 1.57, SD = 1.39, Median = 1.00, MAD = 1.48, range: [0, 4], Skewness = 0.37, Kurtosis = -1.19, 0% missing
> - GPTS_4: n = 164, Mean = 1.48, SD = 1.40, Median = 1.00, MAD = 1.48, range: [0, 4], Skewness = 0.54, Kurtosis = -1.08, 0% missing
> - GPTS_5: n = 164, Mean = 1.43, SD = 1.36, Median = 1.00, MAD = 1.48, range: [0, 4], Skewness = 0.57, Kurtosis = -0.99, 0% missing
> - GPTS_6: n = 164, Mean = 0.76, SD = 0.97, Median = 1.00, MAD = 1.48, range: [0, 4], Skewness = 1.43, Kurtosis = 1.57, 0% missing
> - GPTS_7: n = 164, Mean = 2.20, SD = 1.35, Median = 2.50, MAD = 2.22, range: [0, 4], Skewness = -0.19, Kurtosis = -1.26, 0% missing
> - GPTS_8: n = 164, Mean = 2.09, SD = 1.45, Median = 2.00, MAD = 1.48, range: [0, 4], Skewness = -0.21, Kurtosis = -1.31, 0% missing
> - GPTS_9: n = 164, Mean = 1.24, SD = 1.34, Median = , MAD = 1.48, range: [0, 4], Skewness = 0.81, Kurtosis = -0.68, 0.61% missing
> - GPTS_10: n = 164, Mean = 0.76, SD = 1.05, Median = 0.00, MAD = 0.00, range: [0, 4], Skewness = 1.37, Kurtosis = 0.89, 0% missing
> - GPTS_11: n = 164, Mean = 1.44, SD = 1.32, Median = 1.00, MAD = 1.48, range: [0, 4], Skewness = 0.49, Kurtosis = -1.02, 0% missing
> - GPTS_12: n = 164, Mean = 0.46, SD = 0.92, Median = , MAD = 0.00, range: [0, 4], Skewness = 2.25, Kurtosis = 4.40, 0.61% missing
> - GPTS_13: n = 164, Mean = 0.54, SD = 0.99, Median = 0.00, MAD = 0.00, range: [0, 4], Skewness = 2.03, Kurtosis = 3.32, 0% missing
> - GPTS_14: n = 164, Mean = 0.61, SD = 0.98, Median = 0.00, MAD = 0.00, range: [0, 4], Skewness = 1.86, Kurtosis = 2.89, 0% missing
> - GPTS_15: n = 164, Mean = 0.52, SD = 0.90, Median = 0.00, MAD = 0.00, range: [0, 4], Skewness = 1.97, Kurtosis = 3.30, 0% missing
> - GPTS_16: n = 164, Mean = 0.87, SD = 1.25, Median = 0.00, MAD = 0.00, range: [0, 4], Skewness = 1.34, Kurtosis = 0.49, 0% missing
> - GPTS_17: n = 164, Mean = 1.05, SD = 1.31, Median = 0.50, MAD = 0.74, range: [0, 4], Skewness = 0.97, Kurtosis = -0.45, 0% missing
> - GPTS_18: n = 164, Mean = 0.91, SD = 1.26, Median = , MAD = 0.00, range: [0, 4], Skewness = 1.22, Kurtosis = 0.20, 0.61% missing
> - GPTS_Reference: n = 164, Mean = 12.35, SD = 7.96, Median = , MAD = 8.90, range: [0, 31], Skewness = 0.51, Kurtosis = -0.50, 0.61% missing
> - GPTS_Persecution: n = 164, Mean = 8.33, SD = 8.59, Median = , MAD = 7.41, range: [0, 38], Skewness = 1.09, Kurtosis = 0.43, 1.83% missing
> - GPTS_General: n = 164, Mean = 10.30, SD = 7.76, Median = , MAD = 7.41, range: [0, 33], Skewness = 0.83, Kurtosis = -0.05, 1.83% missingp_GPTS_sg <- descriptive_plot(df_sg, "GPTS", dataset = "Singapore Sample")
p_GPTS_uk <- descriptive_plot(df_uk, "GPTS", dataset = "UK Sample")
p_GPTS_sg + p_GPTS_uk
Self-Control (BSCS)
descriptive_statistics(df_sg, "BSCS", dataset = "Singapore Sample")> The data contains 336 observations of the following variables:
> - BSCS_1: n = 336, Mean = 1.83, SD = 1.04, Median = 2.00, MAD = 1.48, range: [0, 4], Skewness = 0.17, Kurtosis = -0.75, 0% missing
> - BSCS_2: n = 336, Mean = 2.34, SD = 1.09, Median = 2.00, MAD = 1.48, range: [0, 4], Skewness = -0.28, Kurtosis = -0.74, 0% missing
> - BSCS_3: n = 336, Mean = 2.20, SD = 1.17, Median = 2.00, MAD = 1.48, range: [0, 4], Skewness = -0.14, Kurtosis = -0.98, 0% missing
> - BSCS_4: n = 336, Mean = 1.66, SD = 1.10, Median = 2.00, MAD = 1.48, range: [0, 4], Skewness = 0.34, Kurtosis = -0.61, 0% missing
> - BSCS_5: n = 336, Mean = 1.67, SD = 1.18, Median = 2.00, MAD = 1.48, range: [0, 4], Skewness = 0.17, Kurtosis = -1.02, 0% missing
> - BSCS_6: n = 336, Mean = 2.76, SD = 1.09, Median = 3.00, MAD = 1.48, range: [0, 4], Skewness = -0.80, Kurtosis = -0.06, 0% missing
> - BSCS_7: n = 336, Mean = 2.35, SD = 1.09, Median = 3.00, MAD = 1.48, range: [0, 4], Skewness = -0.32, Kurtosis = -0.80, 0% missing
> - BSCS_8: n = 336, Mean = 1.96, SD = 1.18, Median = 2.00, MAD = 1.48, range: [0, 4], Skewness = 0.22, Kurtosis = -0.95, 0% missing
> - BSCS_9: n = 336, Mean = 1.54, SD = 1.00, Median = 1.00, MAD = 1.48, range: [0, 4], Skewness = 0.21, Kurtosis = -0.73, 0% missing
> - BSCS_10: n = 336, Mean = 1.69, SD = 1.16, Median = 2.00, MAD = 1.48, range: [0, 4], Skewness = 0.30, Kurtosis = -0.83, 0% missing
> - BSCS_11: n = 336, Mean = 2.56, SD = 1.11, Median = 3.00, MAD = 1.48, range: [0, 4], Skewness = -0.56, Kurtosis = -0.55, 0% missing
> - BSCS_12: n = 336, Mean = 1.43, SD = 1.03, Median = 1.00, MAD = 1.48, range: [0, 4], Skewness = 0.54, Kurtosis = -0.36, 0% missing
> - BSCS_13: n = 336, Mean = 1.74, SD = 1.06, Median = 2.00, MAD = 1.48, range: [0, 4], Skewness = 0.25, Kurtosis = -0.51, 0% missing
> - BSCS_General: n = 336, Mean = 25.73, SD = 6.14, Median = 25.00, MAD = 5.93, range: [10, 44], Skewness = 0.16, Kurtosis = -0.29, 0% missingdescriptive_statistics(df_uk, "BSCS", dataset = "UK Sample")> The data contains 164 observations of the following variables:
> - BSCS_1: n = 164, Mean = 1.95, SD = 1.10, Median = , MAD = 1.48, range: [0, 4], Skewness = -0.13, Kurtosis = -0.95, 1.22% missing
> - BSCS_2: n = 164, Mean = 2.54, SD = 1.09, Median = , MAD = 1.48, range: [0, 4], Skewness = -0.38, Kurtosis = -0.93, 1.22% missing
> - BSCS_3: n = 164, Mean = 2.15, SD = 1.13, Median = , MAD = 1.48, range: [0, 4], Skewness = -0.22, Kurtosis = -0.86, 0.61% missing
> - BSCS_4: n = 164, Mean = 1.78, SD = 1.21, Median = , MAD = 1.48, range: [0, 4], Skewness = 0.24, Kurtosis = -0.97, 0.61% missing
> - BSCS_5: n = 164, Mean = 2.16, SD = 1.24, Median = 2.00, MAD = 1.48, range: [0, 4], Skewness = -0.27, Kurtosis = -1.06, 0% missing
> - BSCS_6: n = 164, Mean = 2.55, SD = 1.24, Median = , MAD = 1.48, range: [0, 4], Skewness = -0.51, Kurtosis = -0.92, 0.61% missing
> - BSCS_7: n = 164, Mean = 2.55, SD = 1.20, Median = 3.00, MAD = 1.48, range: [0, 4], Skewness = -0.61, Kurtosis = -0.67, 0% missing
> - BSCS_8: n = 164, Mean = 2.60, SD = 1.17, Median = , MAD = 1.48, range: [0, 4], Skewness = -0.39, Kurtosis = -1.05, 0.61% missing
> - BSCS_9: n = 164, Mean = 1.58, SD = 1.05, Median = , MAD = 1.48, range: [0, 4], Skewness = 0.30, Kurtosis = -0.81, 1.83% missing
> - BSCS_10: n = 164, Mean = 1.71, SD = 1.22, Median = , MAD = 1.48, range: [0, 4], Skewness = 0.20, Kurtosis = -1.03, 0.61% missing
> - BSCS_11: n = 164, Mean = 2.45, SD = 1.11, Median = , MAD = 1.48, range: [0, 4], Skewness = -0.37, Kurtosis = -0.92, 0.61% missing
> - BSCS_12: n = 164, Mean = 1.99, SD = 1.14, Median = , MAD = 1.48, range: [0, 4], Skewness = -8.22e-04, Kurtosis = -1.06, 0.61% missing
> - BSCS_13: n = 164, Mean = 1.44, SD = 1.08, Median = , MAD = 1.48, range: [0, 4], Skewness = 0.38, Kurtosis = -0.51, 1.83% missing
> - BSCS_General: n = 164, Mean = 27.58, SD = 6.68, Median = , MAD = 7.41, range: [10, 43], Skewness = 0.02, Kurtosis = -0.62, 3.66% missingp_BSCS_sg <- descriptive_plot(df_sg, "BSCS", dataset = "Singapore Sample")
p_BSCS_uk <- descriptive_plot(df_uk, "BSCS", dataset = "UK Sample")
p_BSCS_sg + p_BSCS_uk
Intolerance to Uncertainty (IUS)
descriptive_statistics(df_sg, "IUS", dataset = "Singapore Sample")> The data contains 336 observations of the following variables:
> - IUS_1: n = 336, Mean = 3.60, SD = 1.49, Median = 4.00, MAD = 1.48, range: [0, 6], Skewness = -0.49, Kurtosis = -0.44, 0% missing
> - IUS_2: n = 336, Mean = 4.23, SD = 1.28, Median = 4.00, MAD = 1.48, range: [0, 6], Skewness = -0.85, Kurtosis = 0.76, 0% missing
> - IUS_3: n = 336, Mean = 4.25, SD = 1.26, Median = 4.00, MAD = 1.48, range: [0, 6], Skewness = -0.83, Kurtosis = 0.86, 0% missing
> - IUS_4: n = 336, Mean = 3.69, SD = 1.52, Median = 4.00, MAD = 1.48, range: [0, 6], Skewness = -0.45, Kurtosis = -0.51, 0% missing
> - IUS_5: n = 336, Mean = 4.01, SD = 1.52, Median = 4.00, MAD = 1.48, range: [0, 6], Skewness = -0.67, Kurtosis = -0.07, 0% missing
> - IUS_6: n = 336, Mean = 2.99, SD = 1.50, Median = 3.00, MAD = 1.48, range: [0, 6], Skewness = -0.05, Kurtosis = -0.69, 0% missing
> - IUS_7: n = 336, Mean = 3.76, SD = 1.45, Median = 4.00, MAD = 1.48, range: [0, 6], Skewness = -0.53, Kurtosis = -0.28, 0% missing
> - IUS_8: n = 336, Mean = 2.90, SD = 1.65, Median = 3.00, MAD = 1.48, range: [0, 6], Skewness = 0.09, Kurtosis = -0.93, 0% missing
> - IUS_9: n = 336, Mean = 2.96, SD = 1.68, Median = 3.00, MAD = 1.48, range: [0, 6], Skewness = -0.03, Kurtosis = -1.00, 0% missing
> - IUS_10: n = 336, Mean = 3.29, SD = 1.65, Median = 4.00, MAD = 1.48, range: [0, 6], Skewness = -0.36, Kurtosis = -0.75, 0% missing
> - IUS_11: n = 336, Mean = 2.93, SD = 1.62, Median = 3.00, MAD = 1.48, range: [0, 6], Skewness = -3.77e-03, Kurtosis = -0.90, 0% missing
> - IUS_12: n = 336, Mean = 2.58, SD = 1.63, Median = 2.00, MAD = 1.48, range: [0, 6], Skewness = 0.27, Kurtosis = -0.66, 0% missing
> - IUS_InhibitoryAnxiety: n = 336, Mean = 14.67, SD = 6.66, Median = 15.00, MAD = 7.41, range: [0, 30], Skewness = -0.02, Kurtosis = -0.54, 0% missing
> - IUS_ProspectiveAnxiety: n = 336, Mean = 26.52, SD = 6.85, Median = 27.00, MAD = 5.93, range: [5, 42], Skewness = -0.46, Kurtosis = 0.34, 0% missing
> - IUS_General: n = 336, Mean = 20.59, SD = 6.15, Median = 20.50, MAD = 5.93, range: [2.50, 36], Skewness = -0.23, Kurtosis = 0.10, 0% missingdescriptive_statistics(df_uk, "IUS", dataset = "UK Sample")> The data contains 164 observations of the following variables:
> - IUS_1: n = 164, Mean = 3.28, SD = 1.65, Median = 4.00, MAD = 1.48, range: [0, 6], Skewness = -0.34, Kurtosis = -0.96, 0% missing
> - IUS_2: n = 164, Mean = 4.38, SD = 1.37, Median = , MAD = 1.48, range: [0, 6], Skewness = -1.11, Kurtosis = 1.40, 0.61% missing
> - IUS_3: n = 164, Mean = 3.63, SD = 1.38, Median = , MAD = 1.48, range: [0, 6], Skewness = -0.50, Kurtosis = 0.13, 0.61% missing
> - IUS_4: n = 164, Mean = 3.30, SD = 1.69, Median = 4.00, MAD = 1.48, range: [0, 6], Skewness = -0.25, Kurtosis = -0.84, 0% missing
> - IUS_5: n = 164, Mean = 3.26, SD = 1.53, Median = 4.00, MAD = 1.48, range: [0, 6], Skewness = -0.26, Kurtosis = -0.70, 0% missing
> - IUS_6: n = 164, Mean = 2.48, SD = 1.64, Median = , MAD = 1.48, range: [0, 6], Skewness = 0.35, Kurtosis = -0.59, 0.61% missing
> - IUS_7: n = 164, Mean = 3.45, SD = 1.55, Median = 4.00, MAD = 1.48, range: [0, 6], Skewness = -0.31, Kurtosis = -0.58, 0% missing
> - IUS_8: n = 164, Mean = 2.45, SD = 1.64, Median = , MAD = 1.48, range: [0, 6], Skewness = 0.22, Kurtosis = -0.88, 0.61% missing
> - IUS_9: n = 164, Mean = 2.21, SD = 1.53, Median = , MAD = 1.48, range: [0, 6], Skewness = 0.35, Kurtosis = -0.74, 1.22% missing
> - IUS_10: n = 164, Mean = 2.79, SD = 1.66, Median = , MAD = 1.48, range: [0, 6], Skewness = 0.09, Kurtosis = -0.90, 0.61% missing
> - IUS_11: n = 164, Mean = 2.95, SD = 1.74, Median = 3.00, MAD = 1.48, range: [0, 6], Skewness = -0.16, Kurtosis = -0.99, 0% missing
> - IUS_12: n = 164, Mean = 2.15, SD = 1.51, Median = 2.00, MAD = 1.48, range: [0, 6], Skewness = 0.31, Kurtosis = -0.56, 0% missing
> - IUS_InhibitoryAnxiety: n = 164, Mean = 12.49, SD = 6.76, Median = , MAD = 5.93, range: [0, 30], Skewness = 0.13, Kurtosis = -0.42, 2.44% missing
> - IUS_ProspectiveAnxiety: n = 164, Mean = 23.81, SD = 7.73, Median = , MAD = 5.93, range: [1, 41], Skewness = -0.36, Kurtosis = 0.22, 1.22% missing
> - IUS_General: n = 164, Mean = 18.15, SD = 6.56, Median = , MAD = 5.19, range: [0.50, 34], Skewness = -0.18, Kurtosis = 0.23, 3.05% missingp_IUS_sg <- descriptive_plot(df_sg, "IUS", dataset = "Singapore Sample")
p_IUS_uk <- descriptive_plot(df_uk, "IUS", dataset = "UK Sample")
p_IUS_sg + p_IUS_uk
Interoception (MAIA2)
descriptive_statistics(df_sg, "MAIA", dataset = "Singapore Sample")> The data contains 336 observations of the following variables:
> - MAIA2_1: n = 336, Mean = 2.61, SD = 1.51, Median = 3.00, MAD = 1.48, range: [0, 5], Skewness = -0.26, Kurtosis = -0.86, 0% missing
> - MAIA2_2: n = 336, Mean = 3.29, SD = 1.39, Median = 4.00, MAD = 1.48, range: [0, 5], Skewness = -0.84, Kurtosis = -0.02, 0% missing
> - MAIA2_3: n = 336, Mean = 2.88, SD = 1.55, Median = 3.00, MAD = 1.48, range: [0, 5], Skewness = -0.39, Kurtosis = -0.87, 0% missing
> - MAIA2_4: n = 336, Mean = 3.17, SD = 1.41, Median = 3.00, MAD = 1.48, range: [0, 5], Skewness = -0.55, Kurtosis = -0.57, 0% missing
> - MAIA2_5: n = 336, Mean = 2.18, SD = 1.53, Median = 2.00, MAD = 1.48, range: [0, 5], Skewness = 0.47, Kurtosis = -0.80, 0% missing
> - MAIA2_6: n = 336, Mean = 1.93, SD = 1.39, Median = 2.00, MAD = 1.48, range: [0, 5], Skewness = 0.49, Kurtosis = -0.48, 0% missing
> - MAIA2_7: n = 336, Mean = 2.49, SD = 1.42, Median = 3.00, MAD = 1.48, range: [0, 5], Skewness = -0.14, Kurtosis = -0.86, 0% missing
> - MAIA2_8: n = 336, Mean = 2.74, SD = 1.32, Median = 3.00, MAD = 1.48, range: [0, 5], Skewness = -0.30, Kurtosis = -0.65, 0% missing
> - MAIA2_9: n = 336, Mean = 2.38, SD = 1.36, Median = 2.00, MAD = 1.48, range: [0, 5], Skewness = 0.11, Kurtosis = -0.81, 0% missing
> - MAIA2_10: n = 336, Mean = 2.90, SD = 1.50, Median = 3.00, MAD = 1.48, range: [0, 5], Skewness = -0.42, Kurtosis = -0.82, 0% missing
> - MAIA2_11: n = 336, Mean = 2.63, SD = 1.57, Median = 3.00, MAD = 1.48, range: [0, 5], Skewness = -0.19, Kurtosis = -1.05, 0% missing
> - MAIA2_12: n = 336, Mean = 3.29, SD = 1.43, Median = 4.00, MAD = 1.48, range: [0, 5], Skewness = -0.68, Kurtosis = -0.35, 0% missing
> - MAIA2_13: n = 336, Mean = 3.48, SD = 1.43, Median = 4.00, MAD = 1.48, range: [0, 5], Skewness = -0.91, Kurtosis = -0.11, 0% missing
> - MAIA2_14: n = 336, Mean = 3.40, SD = 1.38, Median = 4.00, MAD = 1.48, range: [0, 5], Skewness = -0.74, Kurtosis = -0.22, 0% missing
> - MAIA_EmotionalAwareness: n = 336, Mean = 3.14, SD = 1.15, Median = 3.40, MAD = 0.89, range: [0, 5], Skewness = -0.65, Kurtosis = -0.02, 0% missing
> - MAIA_NotWorrying: n = 336, Mean = 2.34, SD = 0.88, Median = 2.30, MAD = 1.04, range: [0, 5], Skewness = 0.09, Kurtosis = -0.22, 0% missing
> - MAIA_Noticing: n = 336, Mean = 2.99, SD = 1.11, Median = 3.00, MAD = 1.11, range: [0, 5], Skewness = -0.35, Kurtosis = -0.24, 0% missing
> - MAIA_General: n = 336, Mean = 2.82, SD = 0.68, Median = 2.83, MAD = 0.65, range: [0.80, 5], Skewness = -0.13, Kurtosis = 0.09, 0% missingdescriptive_statistics(df_uk, "MAIA", dataset = "UK Sample")> The data contains 164 observations of the following variables:
> - MAIA2_1: n = 164, Mean = 2.82, SD = 1.41, Median = 3.00, MAD = 1.48, range: [0, 5], Skewness = -0.26, Kurtosis = -0.83, 0% missing
> - MAIA2_2: n = 164, Mean = 3.64, SD = 1.18, Median = 4.00, MAD = 1.48, range: [0, 5], Skewness = -1.07, Kurtosis = 0.78, 0% missing
> - MAIA2_3: n = 164, Mean = 2.93, SD = 1.42, Median = 3.00, MAD = 1.48, range: [0, 5], Skewness = -0.35, Kurtosis = -0.86, 0% missing
> - MAIA2_4: n = 164, Mean = 3.41, SD = 1.36, Median = 4.00, MAD = 1.48, range: [0, 5], Skewness = -0.61, Kurtosis = -0.61, 0% missing
> - MAIA2_5: n = 164, Mean = 2.23, SD = 1.42, Median = 2.00, MAD = 1.48, range: [0, 5], Skewness = 0.16, Kurtosis = -1.02, 0% missing
> - MAIA2_6: n = 164, Mean = 1.96, SD = 1.49, Median = 2.00, MAD = 1.48, range: [0, 5], Skewness = 0.36, Kurtosis = -0.93, 0% missing
> - MAIA2_7: n = 164, Mean = 2.38, SD = 1.40, Median = 2.00, MAD = 1.48, range: [0, 5], Skewness = 3.55e-03, Kurtosis = -1.06, 0% missing
> - MAIA2_8: n = 164, Mean = 2.63, SD = 1.43, Median = 3.00, MAD = 1.48, range: [0, 5], Skewness = -0.19, Kurtosis = -0.98, 0% missing
> - MAIA2_9: n = 164, Mean = 2.27, SD = 1.32, Median = 2.00, MAD = 1.48, range: [0, 5], Skewness = 0.13, Kurtosis = -0.87, 0% missing
> - MAIA2_10: n = 164, Mean = 2.76, SD = 1.44, Median = 3.00, MAD = 1.48, range: [0, 5], Skewness = -0.43, Kurtosis = -0.89, 0% missing
> - MAIA2_11: n = 164, Mean = 2.65, SD = 1.48, Median = 3.00, MAD = 1.48, range: [0, 5], Skewness = -0.03, Kurtosis = -0.99, 0% missing
> - MAIA2_12: n = 164, Mean = 3.12, SD = 1.44, Median = 3.00, MAD = 1.48, range: [0, 5], Skewness = -0.56, Kurtosis = -0.53, 0% missing
> - MAIA2_13: n = 164, Mean = 3.31, SD = 1.32, Median = 4.00, MAD = 1.48, range: [0, 5], Skewness = -0.64, Kurtosis = -0.41, 0% missing
> - MAIA2_14: n = 164, Mean = 3.15, SD = 1.43, Median = 3.50, MAD = 0.74, range: [0, 5], Skewness = -0.55, Kurtosis = -0.67, 0% missing
> - MAIA_EmotionalAwareness: n = 164, Mean = 3.00, SD = 1.11, Median = 3.20, MAD = 1.19, range: [0.20, 5], Skewness = -0.37, Kurtosis = -0.63, 0% missing
> - MAIA_NotWorrying: n = 164, Mean = 2.30, SD = 1.00, Median = 2.40, MAD = 1.19, range: [0, 4.40], Skewness = -0.17, Kurtosis = -0.69, 0% missing
> - MAIA_Noticing: n = 164, Mean = 3.20, SD = 0.90, Median = 3.25, MAD = 0.74, range: [0.50, 5], Skewness = -0.35, Kurtosis = 0.06, 0% missing
> - MAIA_General: n = 164, Mean = 2.83, SD = 0.57, Median = 2.85, MAD = 0.59, range: [1.28, 4.33], Skewness = -0.29, Kurtosis = -0.07, 0% missingp_MAIA_sg <- descriptive_plot(df_sg, "MAIA", dataset = "Singapore Sample")
p_MAIA_uk <- descriptive_plot(df_uk, "MAIA", dataset = "UK Sample")
p_MAIA_sg + p_MAIA_uk
Schizotypy Personality (SPQ)
descriptive_statistics(df_sg, "SPQ", dataset = "Singapore Sample")> The data contains 336 observations of the following variables:
> - SPQ_1: n = 336, Mean = 0.54, SD = 0.50, Median = 1.00, MAD = 0.00, range: [0, 1], Skewness = -0.14, Kurtosis = -1.98, 0% missing
> - SPQ_2: n = 336, Mean = 0.39, SD = 0.49, Median = 0.00, MAD = 0.00, range: [0, 1], Skewness = 0.44, Kurtosis = -1.81, 0% missing
> - SPQ_3: n = 336, Mean = 0.42, SD = 0.49, Median = 0.00, MAD = 0.00, range: [0, 1], Skewness = 0.31, Kurtosis = -1.90, 0% missing
> - SPQ_4: n = 336, Mean = 0.38, SD = 0.48, Median = 0.00, MAD = 0.00, range: [0, 1], Skewness = 0.52, Kurtosis = -1.73, 0% missing
> - SPQ_5: n = 336, Mean = 0.41, SD = 0.49, Median = 0.00, MAD = 0.00, range: [0, 1], Skewness = 0.36, Kurtosis = -1.87, 0% missing
> - SPQ_6: n = 336, Mean = 0.26, SD = 0.44, Median = 0.00, MAD = 0.00, range: [0, 1], Skewness = 1.11, Kurtosis = -0.79, 0% missing
> - SPQ_7: n = 336, Mean = 0.45, SD = 0.50, Median = 0.00, MAD = 0.00, range: [0, 1], Skewness = 0.22, Kurtosis = -1.95, 0% missing
> - SPQ_8: n = 336, Mean = 0.37, SD = 0.48, Median = 0.00, MAD = 0.00, range: [0, 1], Skewness = 0.56, Kurtosis = -1.69, 0% missing
> - SPQ_9: n = 336, Mean = 0.43, SD = 0.50, Median = 0.00, MAD = 0.00, range: [0, 1], Skewness = 0.28, Kurtosis = -1.92, 0% missing
> - SPQ_10: n = 336, Mean = 0.25, SD = 0.43, Median = 0.00, MAD = 0.00, range: [0, 1], Skewness = 1.16, Kurtosis = -0.67, 0% missing
> - SPQ_11: n = 336, Mean = 0.55, SD = 0.50, Median = 1.00, MAD = 0.00, range: [0, 1], Skewness = -0.19, Kurtosis = -1.96, 0% missing
> - SPQ_12: n = 336, Mean = 0.22, SD = 0.42, Median = 0.00, MAD = 0.00, range: [0, 1], Skewness = 1.36, Kurtosis = -0.18, 0% missing
> - SPQ_13: n = 336, Mean = 0.38, SD = 0.49, Median = 0.00, MAD = 0.00, range: [0, 1], Skewness = 0.48, Kurtosis = -1.77, 0% missing
> - SPQ_14: n = 336, Mean = 0.72, SD = 0.45, Median = 1.00, MAD = 0.00, range: [0, 1], Skewness = -0.99, Kurtosis = -1.04, 0% missing
> - SPQ_15: n = 336, Mean = 0.69, SD = 0.46, Median = 1.00, MAD = 0.00, range: [0, 1], Skewness = -0.81, Kurtosis = -1.35, 0% missing
> - SPQ_16: n = 336, Mean = 0.44, SD = 0.50, Median = 0.00, MAD = 0.00, range: [0, 1], Skewness = 0.25, Kurtosis = -1.94, 0% missing
> - SPQ_17: n = 336, Mean = 0.49, SD = 0.50, Median = 0.00, MAD = 0.00, range: [0, 1], Skewness = 0.05, Kurtosis = -2.00, 0% missing
> - SPQ_18: n = 336, Mean = 0.44, SD = 0.50, Median = 0.00, MAD = 0.00, range: [0, 1], Skewness = 0.25, Kurtosis = -1.94, 0% missing
> - SPQ_19: n = 336, Mean = 0.34, SD = 0.47, Median = 0.00, MAD = 0.00, range: [0, 1], Skewness = 0.70, Kurtosis = -1.52, 0% missing
> - SPQ_20: n = 336, Mean = 0.35, SD = 0.48, Median = 0.00, MAD = 0.00, range: [0, 1], Skewness = 0.61, Kurtosis = -1.63, 0% missing
> - SPQ_21: n = 336, Mean = 0.44, SD = 0.50, Median = 0.00, MAD = 0.00, range: [0, 1], Skewness = 0.25, Kurtosis = -1.94, 0% missing
> - SPQ_22: n = 336, Mean = 0.71, SD = 0.46, Median = 1.00, MAD = 0.00, range: [0, 1], Skewness = -0.92, Kurtosis = -1.16, 0% missing
> - SPQ_CognitivePerceptual: n = 336, Mean = 3.01, SD = 2.05, Median = 3.00, MAD = 1.48, range: [0, 8], Skewness = 0.36, Kurtosis = -0.51, 0% missing
> - SPQ_Disorganized: n = 336, Mean = 2.12, SD = 1.89, Median = 2.00, MAD = 2.97, range: [0, 6], Skewness = 0.59, Kurtosis = -0.79, 0% missing
> - SPQ_Interpersonal: n = 336, Mean = 4.52, SD = 2.44, Median = 5.00, MAD = 2.97, range: [0, 8], Skewness = -0.18, Kurtosis = -1.06, 0% missing
> - SPQ_General: n = 336, Mean = 9.65, SD = 5.11, Median = 9.50, MAD = 5.19, range: [0, 22], Skewness = 0.18, Kurtosis = -0.58, 0% missingdescriptive_statistics(df_uk, "SPQ", dataset = "UK Sample")> The data contains 164 observations of the following variables:
> - SPQ_1: n = 164, Mean = 0.57, SD = 0.50, Median = 1.00, MAD = 0.00, range: [0, 1], Skewness = -0.30, Kurtosis = -1.91, 0% missing
> - SPQ_2: n = 164, Mean = 0.38, SD = 0.49, Median = 0.00, MAD = 0.00, range: [0, 1], Skewness = 0.51, Kurtosis = -1.75, 0% missing
> - SPQ_3: n = 164, Mean = 0.32, SD = 0.47, Median = 0.00, MAD = 0.00, range: [0, 1], Skewness = 0.76, Kurtosis = -1.43, 0% missing
> - SPQ_4: n = 164, Mean = 0.27, SD = 0.45, Median = 0.00, MAD = 0.00, range: [0, 1], Skewness = 1.02, Kurtosis = -0.98, 0% missing
> - SPQ_5: n = 164, Mean = 0.27, SD = 0.45, Median = 0.00, MAD = 0.00, range: [0, 1], Skewness = 1.02, Kurtosis = -0.98, 0% missing
> - SPQ_6: n = 164, Mean = 0.32, SD = 0.47, Median = 0.00, MAD = 0.00, range: [0, 1], Skewness = 0.76, Kurtosis = -1.43, 0% missing
> - SPQ_7: n = 164, Mean = 0.40, SD = 0.49, Median = 0.00, MAD = 0.00, range: [0, 1], Skewness = 0.40, Kurtosis = -1.84, 0% missing
> - SPQ_8: n = 164, Mean = 0.26, SD = 0.44, Median = 0.00, MAD = 0.00, range: [0, 1], Skewness = 1.13, Kurtosis = -0.75, 0% missing
> - SPQ_9: n = 164, Mean = 0.48, SD = 0.50, Median = 0.00, MAD = 0.00, range: [0, 1], Skewness = 0.10, Kurtosis = -1.99, 0% missing
> - SPQ_10: n = 164, Mean = 0.54, SD = 0.50, Median = 1.00, MAD = 0.00, range: [0, 1], Skewness = -0.15, Kurtosis = -1.98, 0% missing
> - SPQ_11: n = 164, Mean = 0.62, SD = 0.49, Median = 1.00, MAD = 0.00, range: [0, 1], Skewness = -0.51, Kurtosis = -1.75, 0% missing
> - SPQ_12: n = 164, Mean = 0.18, SD = 0.38, Median = 0.00, MAD = 0.00, range: [0, 1], Skewness = 1.71, Kurtosis = 0.87, 0% missing
> - SPQ_13: n = 164, Mean = 0.35, SD = 0.48, Median = 0.00, MAD = 0.00, range: [0, 1], Skewness = 0.65, Kurtosis = -1.59, 0% missing
> - SPQ_14: n = 164, Mean = 0.65, SD = 0.48, Median = 1.00, MAD = 0.00, range: [0, 1], Skewness = -0.65, Kurtosis = -1.59, 0% missing
> - SPQ_15: n = 164, Mean = 0.57, SD = 0.50, Median = 1.00, MAD = 0.00, range: [0, 1], Skewness = -0.30, Kurtosis = -1.91, 0% missing
> - SPQ_16: n = 164, Mean = 0.44, SD = 0.50, Median = 0.00, MAD = 0.00, range: [0, 1], Skewness = 0.25, Kurtosis = -1.94, 0% missing
> - SPQ_17: n = 164, Mean = 0.47, SD = 0.50, Median = 0.00, MAD = 0.00, range: [0, 1], Skewness = 0.12, Kurtosis = -1.99, 0% missing
> - SPQ_18: n = 164, Mean = 0.43, SD = 0.50, Median = 0.00, MAD = 0.00, range: [0, 1], Skewness = 0.30, Kurtosis = -1.91, 0% missing
> - SPQ_19: n = 164, Mean = 0.32, SD = 0.47, Median = 0.00, MAD = 0.00, range: [0, 1], Skewness = 0.79, Kurtosis = -1.38, 0% missing
> - SPQ_20: n = 164, Mean = 0.49, SD = 0.50, Median = 0.00, MAD = 0.00, range: [0, 1], Skewness = 0.05, Kurtosis = -2.00, 0% missing
> - SPQ_21: n = 164, Mean = 0.51, SD = 0.50, Median = 1.00, MAD = 0.00, range: [0, 1], Skewness = -0.02, Kurtosis = -2.00, 0% missing
> - SPQ_22: n = 164, Mean = 0.68, SD = 0.47, Median = 1.00, MAD = 0.00, range: [0, 1], Skewness = -0.79, Kurtosis = -1.38, 0% missing
> - SPQ_CognitivePerceptual: n = 164, Mean = 3.02, SD = 1.97, Median = 3.00, MAD = 1.48, range: [0, 8], Skewness = 0.25, Kurtosis = -0.69, 0% missing
> - SPQ_Disorganized: n = 164, Mean = 2.05, SD = 1.81, Median = 2.00, MAD = 1.48, range: [0, 6], Skewness = 0.69, Kurtosis = -0.50, 0% missing
> - SPQ_Interpersonal: n = 164, Mean = 4.44, SD = 2.60, Median = 5.00, MAD = 2.97, range: [0, 8], Skewness = -0.31, Kurtosis = -1.20, 0% missing
> - SPQ_General: n = 164, Mean = 9.52, SD = 4.93, Median = 10.00, MAD = 5.93, range: [0, 22], Skewness = -4.86e-03, Kurtosis = -0.71, 0% missingp_SPQ_sg <- descriptive_plot(df_sg, "SPQ", dataset = "Singapore Sample")
p_SPQ_uk <- descriptive_plot(df_uk, "SPQ", dataset = "UK Sample")
p_SPQ_sg + p_SPQ_uk
Emotionality (PANAS)
descriptive_statistics(df_sg, "PANAS", dataset = "Singapore Sample")> The data contains 336 observations of the following variables:
> - PANAS_State_Distressed: n = 336, Mean = 1.93, SD = 1.22, Median = 2.00, MAD = 1.48, range: [0, 4], Skewness = -0.06, Kurtosis = -1.12, 0% missing
> - PANAS_State_Upset: n = 336, Mean = 1.94, SD = 1.26, Median = 2.00, MAD = 1.48, range: [0, 4], Skewness = -4.17e-03, Kurtosis = -1.15, 0% missing
> - PANAS_State_Guilty: n = 336, Mean = 0.83, SD = 1.08, Median = 0.00, MAD = 0.00, range: [0, 4], Skewness = 1.17, Kurtosis = 0.44, 0% missing
> - PANAS_State_Scared: n = 336, Mean = 1.79, SD = 1.22, Median = 2.00, MAD = 1.48, range: [0, 4], Skewness = 0.07, Kurtosis = -1.02, 0% missing
> - PANAS_State_Hostile: n = 336, Mean = 0.98, SD = 1.08, Median = 1.00, MAD = 1.48, range: [0, 4], Skewness = 0.78, Kurtosis = -0.51, 0% missing
> - PANAS_State_Irritable: n = 336, Mean = 1.80, SD = 1.29, Median = 2.00, MAD = 1.48, range: [0, 4], Skewness = 0.04, Kurtosis = -1.17, 0% missing
> - PANAS_State_Ashamed: n = 336, Mean = 0.68, SD = 0.94, Median = 0.00, MAD = 0.00, range: [0, 4], Skewness = 1.35, Kurtosis = 1.19, 0% missing
> - PANAS_State_Nervous: n = 336, Mean = 1.57, SD = 1.25, Median = 1.50, MAD = 2.22, range: [0, 4], Skewness = 0.20, Kurtosis = -1.15, 0% missing
> - PANAS_State_Jittery: n = 336, Mean = 1.32, SD = 1.24, Median = 1.00, MAD = 1.48, range: [0, 4], Skewness = 0.45, Kurtosis = -1.05, 0% missing
> - PANAS_State_Afraid: n = 336, Mean = 1.74, SD = 1.30, Median = 2.00, MAD = 1.48, range: [0, 4], Skewness = 0.11, Kurtosis = -1.22, 0% missing
> - PANAS_Trait_Distressed: n = 336, Mean = 1.11, SD = 1.13, Median = 1.00, MAD = 1.48, range: [0, 4], Skewness = 0.65, Kurtosis = -0.71, 0% missing
> - PANAS_Trait_Upset: n = 336, Mean = 1.00, SD = 1.11, Median = 1.00, MAD = 1.48, range: [0, 4], Skewness = 0.86, Kurtosis = -0.26, 0% missing
> - PANAS_Trait_Guilty: n = 336, Mean = 0.55, SD = 0.90, Median = 0.00, MAD = 0.00, range: [0, 4], Skewness = 1.65, Kurtosis = 2.02, 0% missing
> - PANAS_Trait_Scared: n = 336, Mean = 0.75, SD = 0.99, Median = 0.00, MAD = 0.00, range: [0, 4], Skewness = 1.23, Kurtosis = 0.74, 0% missing
> - PANAS_Trait_Hostile: n = 336, Mean = 0.62, SD = 0.93, Median = 0.00, MAD = 0.00, range: [0, 4], Skewness = 1.39, Kurtosis = 0.96, 0% missing
> - PANAS_Trait_Irritable: n = 336, Mean = 1.06, SD = 1.10, Median = 1.00, MAD = 1.48, range: [0, 4], Skewness = 0.80, Kurtosis = -0.25, 0% missing
> - PANAS_Trait_Ashamed: n = 336, Mean = 0.49, SD = 0.85, Median = 0.00, MAD = 0.00, range: [0, 4], Skewness = 1.77, Kurtosis = 2.67, 0% missing
> - PANAS_Trait_Nervous: n = 336, Mean = 0.94, SD = 1.08, Median = 1.00, MAD = 1.48, range: [0, 4], Skewness = 0.94, Kurtosis = -0.10, 0% missing
> - PANAS_Trait_Jittery: n = 336, Mean = 0.82, SD = 1.05, Median = 0.00, MAD = 0.00, range: [0, 4], Skewness = 1.13, Kurtosis = 0.35, 0% missing
> - PANAS_Trait_Afraid: n = 336, Mean = 0.82, SD = 0.99, Median = 1.00, MAD = 1.48, range: [0, 4], Skewness = 1.13, Kurtosis = 0.67, 0% missing
> - PANAS_Negative_State: n = 336, Mean = 14.60, SD = 8.51, Median = 14.00, MAD = 8.90, range: [0, 40], Skewness = 0.23, Kurtosis = -0.58, 0% missing
> - PANAS_Negative_Trait: n = 336, Mean = 8.15, SD = 8.06, Median = 6.00, MAD = 8.90, range: [0, 40], Skewness = 1.04, Kurtosis = 0.80, 0% missingdescriptive_statistics(df_uk, "PANAS", dataset = "UK Sample")> The data contains 164 observations of the following variables:
> - PANAS_State_Distressed: n = 164, Mean = 2.15, SD = 1.19, Median = 2.00, MAD = 1.48, range: [0, 4], Skewness = -0.20, Kurtosis = -1.04, 0% missing
> - PANAS_State_Upset: n = 164, Mean = 2.21, SD = 1.20, Median = 2.00, MAD = 1.48, range: [0, 4], Skewness = -0.30, Kurtosis = -0.84, 0% missing
> - PANAS_State_Guilty: n = 164, Mean = 0.96, SD = 1.05, Median = , MAD = 1.48, range: [0, 4], Skewness = 0.76, Kurtosis = -0.56, 0.61% missing
> - PANAS_State_Scared: n = 164, Mean = 1.95, SD = 1.20, Median = 2.00, MAD = 1.48, range: [0, 4], Skewness = -1.31e-03, Kurtosis = -1.06, 0% missing
> - PANAS_State_Hostile: n = 164, Mean = 1.07, SD = 1.08, Median = , MAD = 1.48, range: [0, 4], Skewness = 0.81, Kurtosis = -0.20, 0.61% missing
> - PANAS_State_Irritable: n = 164, Mean = 2.19, SD = 1.28, Median = , MAD = 1.48, range: [0, 4], Skewness = -0.33, Kurtosis = -1.09, 0.61% missing
> - PANAS_State_Ashamed: n = 164, Mean = 0.70, SD = 0.96, Median = 0.00, MAD = 0.00, range: [0, 4], Skewness = 1.32, Kurtosis = 0.80, 0% missing
> - PANAS_State_Nervous: n = 164, Mean = 2.34, SD = 1.15, Median = , MAD = 1.48, range: [0, 4], Skewness = -0.40, Kurtosis = -0.77, 1.22% missing
> - PANAS_State_Jittery: n = 164, Mean = 1.34, SD = 1.26, Median = 1.00, MAD = 1.48, range: [0, 4], Skewness = 0.62, Kurtosis = -0.76, 0% missing
> - PANAS_State_Afraid: n = 164, Mean = 1.99, SD = 1.21, Median = , MAD = 1.48, range: [0, 4], Skewness = 0.03, Kurtosis = -1.10, 1.22% missing
> - PANAS_Trait_Distressed: n = 164, Mean = 1.06, SD = 1.12, Median = , MAD = 1.48, range: [0, 4], Skewness = 0.77, Kurtosis = -0.51, 1.22% missing
> - PANAS_Trait_Upset: n = 164, Mean = 1.06, SD = 1.09, Median = , MAD = 1.48, range: [0, 4], Skewness = 0.72, Kurtosis = -0.57, 0.61% missing
> - PANAS_Trait_Guilty: n = 164, Mean = 0.48, SD = 0.84, Median = 0.00, MAD = 0.00, range: [0, 4], Skewness = 1.91, Kurtosis = 3.16, 0% missing
> - PANAS_Trait_Scared: n = 164, Mean = 0.59, SD = 0.83, Median = 0.00, MAD = 0.00, range: [0, 3], Skewness = 1.34, Kurtosis = 0.96, 0% missing
> - PANAS_Trait_Hostile: n = 164, Mean = 0.48, SD = 0.77, Median = , MAD = 0.00, range: [0, 4], Skewness = 1.68, Kurtosis = 2.68, 0.61% missing
> - PANAS_Trait_Irritable: n = 164, Mean = 1.22, SD = 1.14, Median = , MAD = 1.48, range: [0, 4], Skewness = 0.58, Kurtosis = -0.72, 1.22% missing
> - PANAS_Trait_Ashamed: n = 164, Mean = 0.39, SD = 0.71, Median = 0.00, MAD = 0.00, range: [0, 3], Skewness = 1.93, Kurtosis = 3.18, 0% missing
> - PANAS_Trait_Nervous: n = 164, Mean = 1.33, SD = 1.16, Median = , MAD = 1.48, range: [0, 4], Skewness = 0.45, Kurtosis = -0.94, 0.61% missing
> - PANAS_Trait_Jittery: n = 164, Mean = 0.68, SD = 1.00, Median = , MAD = 0.00, range: [0, 4], Skewness = 1.39, Kurtosis = 0.98, 0.61% missing
> - PANAS_Trait_Afraid: n = 164, Mean = 0.60, SD = 0.83, Median = 0.00, MAD = 0.00, range: [0, 3], Skewness = 1.37, Kurtosis = 1.18, 0% missing
> - PANAS_Negative_State: n = 164, Mean = 16.91, SD = 7.45, Median = , MAD = 7.41, range: [0, 35], Skewness = -0.06, Kurtosis = -0.65, 1.83% missing
> - PANAS_Negative_Trait: n = 164, Mean = 7.83, SD = 6.84, Median = , MAD = 5.93, range: [0, 25], Skewness = 0.72, Kurtosis = -0.61, 2.44% missingp_PANAS_sg <- descriptive_plot(df_sg, "PANAS", dataset = "Singapore Sample")
p_PANAS_uk <- descriptive_plot(df_uk, "PANAS", dataset = "UK Sample")
p_PANAS_sg + p_PANAS_uk
Transform Data to Long Type
df_combined <- df_combined %>% arrange(Dataset)
# Reshape Data
names(df_combined) <- gsub("[News]_", "", names(df_combined))
df_long <- df_combined %>% pivot_longer(cols = starts_with("New"), names_to = c("News_Item",
".value"), names_sep = "_", ) %>% mutate(News_Item = as.numeric(str_remove(News_Item,
"New"))) %>% rename(News_Belief = Belief, News_Familiarity = Familiarity, News_Importance = Importance) %>%
# Marker of Fake or Real (1-11 items are fake, scored 0)
mutate(Type = as.factor(ifelse(News_Item >= 1 & News_Item <= 11, "Fake News", "Real News")))
# Convert to factor
df_long$News_Item <- as.factor(df_long$News_Item)
colors_fakereal <- c(`Fake News` = "#d0008b", `Real News` = "#63d10f")News Items
News headlines were scored from a scale of 0 to 6, on whether they are perceived as 1) accurate (truth value), 2) important, and 3) familiar. Higher scores indicate strong beliefs of truthness, importance, and familiarity respectively.
# Beliefs
df_long %>% ggplot(aes(x = News_Belief, color = Type)) + xlab("Reality Belief") +
geom_density(size = 1, alpha = 0.5, adjust = 2, position = "identity", binwidth = 1) +
scale_color_manual(values = colors_fakereal) + geom_vline(xintercept = 0, linetype = "dashed") +
ggtitle("Distribution of Belief Rating for Fake and Real News") + theme_modern()
Analysis of Psychological Mechanisms underlying News Beliefs
Baseline Model
baseline_model <- glmmTMB(News_Belief ~ Type + (1 + Type | Participant) + (1 | News_Item) +
(1 | Dataset), data = df_long)
# Include Type as random slope since truth value may have different effect on
# participants
model_parameters(baseline_model)| Parameter | Coefficient | SE | CI_low | CI_high | z | df_error | p |
|---|---|---|---|---|---|---|---|
| (Intercept) | -1.5 | 0.49 | -2.4 | -0.52 | -3.0 | Inf | 0 |
| TypeReal News | 2.7 | 0.60 | 1.6 | 3.92 | 4.5 | Inf | 0 |
r2(baseline_model)> # R2 for Mixed Models
>
> Conditional R2: 0.378
> Marginal R2: 0.155# Plot baseline difference
modelbased::estimate_means(baseline_model) %>% ggplot(aes(x = Type, y = Mean, color = Type)) +
geom_line(aes(group = 1), size = 1) + geom_pointrange(aes(ymin = CI_low, ymax = CI_high),
size = 1) + theme_modern() + geom_hline(yintercept = 0, linetype = "dashed") +
ylab("Reality Belief") + xlab("Type") + scale_color_manual(values = colors_fakereal)
# Familiarity
model_familiarity <- glmmTMB(News_Belief ~ Type/News_Familiarity + (1 + Type | Participant) +
(1 | News_Item), data = df_long)
model_parameters(model_familiarity)| Parameter | Coefficient | SE | CI_low | CI_high | z | df_error | p |
|---|---|---|---|---|---|---|---|
| (Intercept) | -1.33 | 0.29 | -1.89 | -0.77 | -4.6 | Inf | 0 |
| TypeReal News | 2.33 | 0.40 | 1.55 | 3.12 | 5.8 | Inf | 0 |
| TypeFake News:News_Familiarity | 0.30 | 0.01 | 0.28 | 0.32 | 28.7 | Inf | 0 |
| TypeReal News:News_Familiarity | 0.51 | 0.01 | 0.49 | 0.53 | 49.8 | Inf | 0 |
r2(model_familiarity)> # R2 for Mixed Models
>
> Conditional R2: 0.486
> Marginal R2: 0.372# Visualize
modelbased::estimate_link(model_familiarity, target = c("Type", "News_Familiarity")) %>%
ggplot(aes(x = News_Familiarity, y = Predicted)) + geom_ribbon(aes(ymin = CI_low,
ymax = CI_high, fill = Type), alpha = 0.33) + geom_line(aes(color = Type), size = 1) +
theme_modern() + ylab("Reality Belief") + xlab("News Familiarity") + ggtitle("Effect of Familiarity on Reality Perception") +
scale_color_manual(values = colors_fakereal) + scale_fill_manual(values = colors_fakereal)
# # Importance model_importance <- glmmTMB(News_Belief ~ Type * News_Importance +
# (1+Type|Participant) + (1|Dataset) + (1|News_Item), data = df_long)
# model_parameters(model_importance) # Visualize
# modelbased::estimate_link(model_importance) %>% ggplot(aes(x=News_Importance,
# y=Predicted)) + geom_ribbon(aes(ymin = CI_low, ymax = CI_high, fill=Type),
# alpha=0.33) + geom_line(aes(color=Type), size = 1) + theme_modern() +
# ylab('Reality Belief') + xlab('News Importance') + ggtitle('Effect of News
# Importance on Reality Perception') + scale_color_manual(values=colors_fakereal)
# + scale_fill_manual(values=colors_fakereal)Here, we show that individuals are more likely to perceive news as accurate if the news item was real as compared to if it was fake, after controlling for the sample (i.e., UK or SG sample) and the different news items presented within the samples.
Effect of Sociodemographics
Gender
model_sex <- glmmTMB(News_Belief ~ Type/Gender + News_Familiarity + (1 + Type | Participant) +
(1 | Dataset) + (1 | News_Item), data = df_long)
model_parameters(model_sex)| Parameter | Coefficient | SE | CI_low | CI_high | z | df_error | p |
|---|---|---|---|---|---|---|---|
| (Intercept) | -1.30 | 0.31 | -1.90 | -0.69 | -4.20 | Inf | 0.00 |
| TypeReal News | 2.35 | 0.43 | 1.52 | 3.19 | 5.54 | Inf | 0.00 |
| News_Familiarity | 0.40 | 0.01 | 0.39 | 0.42 | 53.62 | Inf | 0.00 |
| TypeFake News:GenderMale | -0.12 | 0.09 | -0.31 | 0.06 | -1.31 | Inf | 0.19 |
| TypeReal News:GenderMale | 0.01 | 0.08 | -0.14 | 0.17 | 0.15 | Inf | 0.88 |
r2(model_sex)> # R2 for Mixed Models
>
> Conditional R2: 0.479
> Marginal R2: 0.357# Visualize
modelbased::estimate_means(model_sex) %>% ggplot(aes(x = Gender, y = Mean, group = Type,
color = Type)) + # geom_ribbon(aes(ymin = CI_low, ymax = CI_high, fill=Type), alpha=0.5) +
geom_line(size = 1) + geom_pointrange(aes(ymin = CI_low, ymax = CI_high), size = 1) +
theme_modern() + ylab("Reality Belief") + xlab("Effect of Gender on Reality Perception") +
scale_color_manual(values = colors_fakereal)
There is no effect of gender on the perception of news information as accurate.
Age
model_age <- glmmTMB(News_Belief ~ Type/Age + Education + News_Familiarity + (1 +
Type | Participant) + (1 | Dataset) + (1 | News_Item), data = df_long)
model_parameters(model_age)| Parameter | Coefficient | SE | CI_low | CI_high | z | df_error | p |
|---|---|---|---|---|---|---|---|
| (Intercept) | -0.94 | 0.34 | -1.60 | -0.29 | -2.81 | Inf | 0.00 |
| TypeReal News | 2.00 | 0.45 | 1.13 | 2.88 | 4.48 | Inf | 0.00 |
| Education | -0.01 | 0.01 | -0.04 | 0.02 | -0.41 | Inf | 0.68 |
| News_Familiarity | 0.41 | 0.01 | 0.39 | 0.42 | 53.40 | Inf | 0.00 |
| TypeFake News:Age | -0.01 | 0.00 | -0.02 | -0.01 | -3.28 | Inf | 0.00 |
| TypeReal News:Age | 0.00 | 0.00 | -0.01 | 0.01 | 0.01 | Inf | 1.00 |
r2(model_age)> # R2 for Mixed Models
>
> Conditional R2: 0.481
> Marginal R2: 0.358# Visualize
modelbased::estimate_link(model_age, target = c("Type", "Age")) %>% ggplot(aes(x = Age,
y = Predicted)) + geom_ribbon(aes(ymin = CI_low, ymax = CI_high, fill = Type),
alpha = 0.33) + geom_line(aes(color = Type), size = 1) + theme_modern() + ylab("Reality Belief") +
xlab("Age") + ggtitle("Effect of Age on Reality Perception") + scale_color_manual(values = colors_fakereal) +
scale_fill_manual(values = colors_fakereal)
There is negative effect of age on the perception of news information as accurate.
Education
model_education <- glmmTMB(News_Belief ~ Type/Education + News_Familiarity + Age +
(1 + Type | Participant) + (1 | Dataset) + (1 | News_Item), data = df_long)
model_parameters(model_education)| Parameter | Coefficient | SE | CI_low | CI_high | z | df_error | p |
|---|---|---|---|---|---|---|---|
| (Intercept) | -1.11 | 0.33 | -1.75 | -0.47 | -3.39 | Inf | 0.00 |
| TypeReal News | 2.29 | 0.43 | 1.45 | 3.13 | 5.33 | Inf | 0.00 |
| News_Familiarity | 0.41 | 0.01 | 0.39 | 0.42 | 53.47 | Inf | 0.00 |
| Age | -0.01 | 0.00 | -0.01 | 0.00 | -1.82 | Inf | 0.07 |
| TypeFake News:Education | -0.03 | 0.02 | -0.07 | 0.01 | -1.58 | Inf | 0.11 |
| TypeReal News:Education | 0.01 | 0.02 | -0.02 | 0.05 | 0.66 | Inf | 0.51 |
r2(model_education)> # R2 for Mixed Models
>
> Conditional R2: 0.481
> Marginal R2: 0.358# Visualize
modelbased::estimate_link(model_education, target = c("Type", "Education")) %>% ggplot(aes(x = Education,
y = Predicted)) + geom_ribbon(aes(ymin = CI_low, ymax = CI_high, fill = Type),
alpha = 0.33) + geom_line(aes(color = Type), size = 1) + theme_modern() + ylab("Reality Belief") +
xlab("Education (No. of Years after High School)") + ggtitle("Effect of Education on Reality Perception") +
scale_color_manual(values = colors_fakereal) + scale_fill_manual(values = colors_fakereal)
Education has no significant effect on the belief of news.
Effect of COVID-related Measures
Precautionary Measures
model_measures <- glmmTMB(News_Belief ~ Type/MeasureG + News_Familiarity + (1 + Type |
Participant) + (1 | Dataset) + (1 | News_Item), data = df_long)
model_parameters(model_measures)| Parameter | Coefficient | SE | CI_low | CI_high | z | df_error | p |
|---|---|---|---|---|---|---|---|
| (Intercept) | -1.33 | 0.30 | -1.93 | -0.73 | -4.4 | Inf | 0.00 |
| TypeReal News | 2.40 | 0.42 | 1.57 | 3.23 | 5.7 | Inf | 0.00 |
| News_Familiarity | 0.40 | 0.01 | 0.39 | 0.42 | 53.4 | Inf | 0.00 |
| TypeFake News:MeasureG | -0.05 | 0.04 | -0.14 | 0.04 | -1.2 | Inf | 0.24 |
| TypeReal News:MeasureG | 0.14 | 0.04 | 0.07 | 0.22 | 3.7 | Inf | 0.00 |
r2(model_measures)> # R2 for Mixed Models
>
> Conditional R2: 0.479
> Marginal R2: 0.358check_outliers(model_measures)> NULL# Visualize
modelbased::estimate_link(model_measures, target = c("Type", "MeasureG")) %>% ggplot(aes(x = MeasureG,
y = Predicted)) + geom_ribbon(aes(ymin = CI_low, ymax = CI_high, fill = Type),
alpha = 0.33) + geom_line(aes(color = Type), size = 1) + theme_modern() + xlab("Reality Belief") +
ylab("Measure Compliance") + ggtitle("Effect of COVID-19 Measure Compliance on Reality Perception") +
scale_color_manual(values = colors_fakereal) + scale_fill_manual(values = colors_fakereal)
Government Opinions
model_gov <- glmmTMB(News_Belief ~ Type/Gov_G + News_Familiarity + (1 + Type | Participant) +
(1 | Dataset) + (1 | News_Item), data = df_long)
model_parameters(model_gov)| Parameter | Coefficient | SE | CI_low | CI_high | z | df_error | p |
|---|---|---|---|---|---|---|---|
| (Intercept) | -1.33 | 0.31 | -1.94 | -0.73 | -4.3 | Inf | 0.00 |
| TypeReal News | 2.40 | 0.42 | 1.57 | 3.23 | 5.7 | Inf | 0.00 |
| News_Familiarity | 0.40 | 0.01 | 0.39 | 0.42 | 53.3 | Inf | 0.00 |
| TypeFake News:Gov_G | -0.13 | 0.05 | -0.23 | -0.03 | -2.5 | Inf | 0.01 |
| TypeReal News:Gov_G | 0.11 | 0.05 | 0.02 | 0.20 | 2.3 | Inf | 0.02 |
r2(model_gov)> # R2 for Mixed Models
>
> Conditional R2: 0.479
> Marginal R2: 0.357# Visualize
modelbased::estimate_link(model_gov, target = c("Type", "Gov_G")) %>% ggplot(aes(x = Gov_G,
y = Predicted)) + geom_ribbon(aes(ymin = CI_low, ymax = CI_high, fill = Type),
alpha = 0.33) + geom_line(aes(color = Type), size = 1) + theme_modern() + ylab("Reality Belief") +
xlab("Opinions about Government (Negative to Positive)") + ggtitle("Effect of COVID-19 Government Opinions on Reality Perception") +
scale_color_manual(values = colors_fakereal) + scale_fill_manual(values = colors_fakereal)
Personal Impact
model_impact <- glmmTMB(News_Belief ~ Type/Impact_G + News_Familiarity + (1 + Type |
Participant) + (1 | Dataset) + (1 | News_Item), data = df_long)
model_parameters(model_impact)| Parameter | Coefficient | SE | CI_low | CI_high | z | df_error | p |
|---|---|---|---|---|---|---|---|
| (Intercept) | -1.34 | 0.31 | -1.94 | -0.74 | -4.37 | Inf | 0.00 |
| TypeReal News | 2.40 | 0.42 | 1.57 | 3.23 | 5.68 | Inf | 0.00 |
| News_Familiarity | 0.41 | 0.01 | 0.39 | 0.42 | 53.39 | Inf | 0.00 |
| TypeFake News:Impact_G | -0.01 | 0.04 | -0.09 | 0.08 | -0.18 | Inf | 0.86 |
| TypeReal News:Impact_G | -0.06 | 0.04 | -0.14 | 0.01 | -1.69 | Inf | 0.09 |
r2(model_impact)> # R2 for Mixed Models
>
> Conditional R2: 0.479
> Marginal R2: 0.357# Visualize
modelbased::estimate_link(model_impact, target = c("Type", "Impact_G")) %>% ggplot(aes(x = Impact_G,
y = Predicted)) + geom_ribbon(aes(ymin = CI_low, ymax = CI_high, fill = Type),
alpha = 0.33) + geom_line(aes(color = Type), size = 1) + theme_modern() + ylab("Reality Belief") +
xlab("Personal Impact (Negative to Positive)") + ggtitle("Effect of COVID-19 Personal Impact on Reality Perception") +
scale_color_manual(values = colors_fakereal) + scale_fill_manual(values = colors_fakereal)
News Frequency
model_newsf <- glmmTMB(News_Belief ~ Type/Frequency_COVID + News_Familiarity + (1 +
Type | Participant) + (1 | Dataset) + (1 | News_Item), data = df_long)
model_parameters(model_newsf)| Parameter | Coefficient | SE | CI_low | CI_high | z | df_error | p |
|---|---|---|---|---|---|---|---|
| (Intercept) | -1.00 | 0.32 | -1.63 | -0.37 | -3.1 | Inf | 0.00 |
| TypeReal News | 1.97 | 0.43 | 1.12 | 2.82 | 4.5 | Inf | 0.00 |
| News_Familiarity | 0.40 | 0.01 | 0.39 | 0.42 | 53.4 | Inf | 0.00 |
| TypeFake News:Frequency_COVID | -0.18 | 0.04 | -0.26 | -0.10 | -4.3 | Inf | 0.00 |
| TypeReal News:Frequency_COVID | 0.05 | 0.03 | -0.02 | 0.11 | 1.3 | Inf | 0.19 |
r2(model_newsf)> # R2 for Mixed Models
>
> Conditional R2: 0.481
> Marginal R2: 0.357# Visualize
modelbased::estimate_link(model_newsf, target = c("Type", "Frequency_COVID")) %>%
ggplot(aes(x = Frequency_COVID, y = Predicted)) + geom_ribbon(aes(ymin = CI_low,
ymax = CI_high, fill = Type), alpha = 0.33) + geom_line(aes(color = Type), size = 1) +
theme_modern() + ylab("Reality Belief") + xlab("Frequency of Reading COVID-19 News") +
ggtitle("Effect of News Reading Frequency on Reality Perception") + scale_color_manual(values = colors_fakereal) +
scale_fill_manual(values = colors_fakereal)
News Sources
model_newssource <- glmmTMB(News_Belief ~ Type/(SourcNewspaper + SourcOfficialSites +
SourcSharedLinks + SourcSocialNetworks) + News_Familiarity + (1 + Type | Participant) +
(1 | Dataset) + (1 | News_Item), data = df_long)
model_parameters(model_newssource)| Parameter | Coefficient | SE | CI_low | CI_high | z | df_error | p |
|---|---|---|---|---|---|---|---|
| (Intercept) | -1.15 | 0.35 | -1.84 | -0.45 | -3.24 | Inf | 0.00 |
| TypeReal News | 2.10 | 0.48 | 1.17 | 3.04 | 4.40 | Inf | 0.00 |
| News_Familiarity | 0.41 | 0.01 | 0.39 | 0.42 | 53.58 | Inf | 0.00 |
| TypeFake News:SourcNewspaper | -0.01 | 0.03 | -0.06 | 0.04 | -0.45 | Inf | 0.66 |
| TypeReal News:SourcNewspaper | -0.03 | 0.02 | -0.07 | 0.01 | -1.49 | Inf | 0.14 |
| TypeFake News:SourcOfficialSites | -0.06 | 0.03 | -0.11 | -0.01 | -2.16 | Inf | 0.03 |
| TypeReal News:SourcOfficialSites | 0.01 | 0.02 | -0.03 | 0.06 | 0.48 | Inf | 0.63 |
| TypeFake News:SourcSharedLinks | 0.08 | 0.02 | 0.04 | 0.12 | 3.59 | Inf | 0.00 |
| TypeReal News:SourcSharedLinks | 0.00 | 0.02 | -0.04 | 0.04 | 0.04 | Inf | 0.97 |
| TypeFake News:SourcSocialNetworks | -0.02 | 0.03 | -0.08 | 0.03 | -0.92 | Inf | 0.36 |
| TypeReal News:SourcSocialNetworks | 0.02 | 0.02 | -0.02 | 0.07 | 0.96 | Inf | 0.34 |
r2(model_newssource)> # R2 for Mixed Models
>
> Conditional R2: 0.479
> Marginal R2: 0.359Effect of Personality Traits
Principal Component Analysis (for dimensions)
items <- df_combined %>% select(-matches("CMQ_\\d")) %>% select(-matches("BSCS_\\d")) %>%
select(-matches("PBS_\\d")) %>% select(-matches("SPQ_\\d")) %>% select(-matches("MAIA2_\\d")) %>%
select(-matches("GPTS_\\d")) %>% select(-matches("IUS_\\d")) %>% select(-matches("PANAS_Stat")) %>%
select(-matches("PANAS_Trait")) %>% select(-GPTS_General, -IUS_General, -PBS_General,
-SPQ_General, -MAIA_General) %>% select(starts_with("BSCS"), starts_with("GPTS"),
starts_with("CMQ"), starts_with("MAIA"), starts_with("PBS"), starts_with("PANAS"),
starts_with("SPQ"), starts_with("IUS"), Religion)
# Check Factor Structure
parameters::check_factorstructure(items)> # Is the data suitable for Factor Analysis?
>
> - KMO: The Kaiser, Meyer, Olkin (KMO) measure of sampling adequacy suggests that data seems appropriate for factor analysis (KMO = 0.82).
> - Sphericity: Bartlett's test of sphericity suggests that there is sufficient significant correlation in the data for factor analysis (Chisq(171) = 3949.96, p < .001).cor <- correlation::correlation(items)
# How many factor
parameters::n_components(items, cor = cor, rotation = "promax", package = "all",
safe = FALSE) %T>% print() %>% plot() + theme_modern()> # Method Agreement Procedure:
>
> The choice of 6 dimensions is supported by 4 (21.05%) methods out of 19 (Bentler, Parallel analysis, Kaiser criterion, SE Scree).
# Run PCA
pca <- principal_components(items, n = 6, rotation = "promax", threshold = "max",
sort = TRUE)
pca| Variable | RC1 | RC2 | RC6 | RC5 | RC3 | RC4 | Complexity | Uniqueness | MSA |
|---|---|---|---|---|---|---|---|---|---|
| SPQ_Disorganized | 0.84 | 1.1 | 0.34 | 0.85 | |||||
| BSCS_General | 0.72 | 1.4 | 0.50 | 0.86 | |||||
| SPQ_Interpersonal | 0.63 | 2.3 | 0.38 | 0.83 | |||||
| SPQ_CognitivePerceptual | 0.62 | 1.5 | 0.39 | 0.92 | |||||
| GPTS_Reference | 0.46 | 2.5 | 0.35 | 0.83 | |||||
| CMQ_General | 0.39 | 2.9 | 0.52 | 0.92 | |||||
| PBS_Precognition | 0.94 | 1.0 | 0.16 | 0.80 | |||||
| PBS_Spiritualism | 0.86 | 1.0 | 0.19 | 0.81 | |||||
| PBS_Psi | 0.85 | 1.1 | 0.27 | 0.87 | |||||
| Religion | 0.98 | 1.1 | 0.17 | 0.62 | |||||
| PBS_ReligiousBeliefs | 0.88 | 1.1 | 0.17 | 0.69 | |||||
| PANAS_NegativState | 0.86 | 1.2 | 0.28 | 0.81 | |||||
| PANAS_NegativTrait | 0.81 | 1.1 | 0.30 | 0.84 | |||||
| GPTS_Persecution | 0.54 | 2.2 | 0.32 | 0.83 | |||||
| MAIA_Noticing | 0.93 | 1.1 | 0.26 | 0.68 | |||||
| MAIA_EmotionalAwareness | 0.88 | 1.1 | 0.28 | 0.75 | |||||
| IUS_ProspectiveAnxiety | 0.84 | 1.2 | 0.25 | 0.82 | |||||
| IUS_InhibitoryAnxiety | 0.79 | 1.1 | 0.21 | 0.81 | |||||
| MAIA_NotWorrying | -0.54 | 2.0 | 0.52 | 0.91 |
summary(pca)| Parameter | RC1 | RC2 | RC6 | RC5 | RC3 | RC4 |
|---|---|---|---|---|---|---|
| Eigenvalues | 5.44 | 2.65 | 1.51 | 1.26 | 1.19 | 1.10 |
| Variance | 0.14 | 0.13 | 0.10 | 0.11 | 0.10 | 0.11 |
| Variance_Cumulative | 0.14 | 0.27 | 0.38 | 0.49 | 0.59 | 0.69 |
| Variance_Proportion | 0.20 | 0.19 | 0.15 | 0.16 | 0.14 | 0.15 |
# save table
pca_kable <- as.data.frame(pca) %>% select(Variable, RC1, RC2, RC6, RC5, RC3, RC4)
pca_kable$Variable[which(pca_kable$Variable == "PANAS_NegativState")] <- "PANAS_NegativeState"
pca_kable$Variable[which(pca_kable$Variable == "PANAS_NegativTrait")] <- "PANAS_NegativeTrait"
kableExtra::kbl(pca_kable, align = "c") %>% kableExtra::kable_classic(full_width = F) %>%
kableExtra::footnote(general = "RC1: Disorganized Thoughts and Behaviours, RC2: Paranormal Beliefs, RC6: Religiosity, RC5: Negative Affect, RC3: Sensitivity, RC4: Intolerance to Discomfort") %>%
kableExtra::save_kable("figures/pca_table.pdf")
# write.csv(pca_table, 'figures/pca_table.csv', row.names = FALSE)Dataframe with Predicted Scores
scores <- predict(pca, names = c("Disorganized", "Paranormal_Beliefs", "Religiosity",
"Negative_Affect", "Sensitivity", "Intolerance_Discomfort"))
scores$Participant <- paste0("S", 1:nrow(scores))
df_scores <- merge(df_long, scores, by = "Participant")
df_scores %>% select(Age, Education, Disorganized, Paranormal_Beliefs, Religiosity) %>%
correlation::correlation() %>% summary(redundant = TRUE)| Parameter | Age | Education | Disorganized | Paranormal_Beliefs | Religiosity |
|---|---|---|---|---|---|
| Age | 1.00 | 0.12 | -0.11 | 0.11 | 0.09 |
| Education | 0.12 | 1.00 | -0.02 | -0.13 | -0.03 |
| Disorganized | -0.11 | -0.02 | 1.00 | 0.25 | 0.17 |
| Paranormal_Beliefs | 0.11 | -0.13 | 0.25 | 1.00 | 0.35 |
| Religiosity | 0.09 | -0.03 | 0.17 | 0.35 | 1.00 |
Disorganized
model_disorganized <- glmmTMB(News_Belief ~ Type/Disorganized + News_Familiarity +
(1 + Type | Participant) + (1 | Dataset) + (1 | News_Item), data = df_scores)
model_parameters(model_disorganized)| Parameter | Coefficient | SE | CI_low | CI_high | z | df_error | p |
|---|---|---|---|---|---|---|---|
| (Intercept) | -1.33 | 0.31 | -1.93 | -0.73 | -4.33 | Inf | 0.00 |
| TypeReal News | 2.39 | 0.43 | 1.56 | 3.22 | 5.63 | Inf | 0.00 |
| News_Familiarity | 0.40 | 0.01 | 0.39 | 0.42 | 52.89 | Inf | 0.00 |
| TypeFake News:Disorganized | 0.13 | 0.06 | 0.01 | 0.24 | 2.21 | Inf | 0.03 |
| TypeReal News:Disorganized | 0.01 | 0.04 | -0.07 | 0.10 | 0.24 | Inf | 0.81 |
r2(model_disorganized)> # R2 for Mixed Models
>
> Conditional R2: 0.478
> Marginal R2: 0.357modelbased::estimate_link(model_disorganized, target = c("Type", "Disorganized")) %>%
ggplot(aes(x = Disorganized, y = Predicted)) + geom_ribbon(aes(ymin = CI_low,
ymax = CI_high, fill = Type), alpha = 0.33) + geom_line(aes(color = Type), size = 1) +
theme_modern() + ylab("Reality Belief") + xlab("Disorganized") + ggtitle("Effect of Disorganized on Reality Perception") +
scale_color_manual(values = colors_fakereal) + scale_fill_manual(values = colors_fakereal)
Disorganized has a significant positive effect on the belief of Fake News where individuals with higher level of disorganized are more likely to believe in fake news.
Paranormal Belief
model_parabelief <- glmmTMB(News_Belief ~ Type/Paranormal_Beliefs + News_Familiarity +
(1 + Type | Participant) + (1 | Dataset) + (1 | News_Item), data = df_scores)
model_parameters(model_parabelief)| Parameter | Coefficient | SE | CI_low | CI_high | z | df_error | p |
|---|---|---|---|---|---|---|---|
| (Intercept) | -1.37 | 0.31 | -1.97 | -0.77 | -4.5 | Inf | 0.0 |
| TypeReal News | 2.42 | 0.42 | 1.59 | 3.26 | 5.7 | Inf | 0.0 |
| News_Familiarity | 0.40 | 0.01 | 0.39 | 0.42 | 52.9 | Inf | 0.0 |
| TypeFake News:Paranormal_Beliefs | 0.29 | 0.05 | 0.19 | 0.40 | 5.4 | Inf | 0.0 |
| TypeReal News:Paranormal_Beliefs | 0.05 | 0.04 | -0.03 | 0.13 | 1.3 | Inf | 0.2 |
r2(model_parabelief)> # R2 for Mixed Models
>
> Conditional R2: 0.479
> Marginal R2: 0.360modelbased::estimate_link(model_parabelief, target = c("Type", "Paranormal_Beliefs")) %>%
ggplot(aes(x = Paranormal_Beliefs, y = Predicted)) + geom_ribbon(aes(ymin = CI_low,
ymax = CI_high, fill = Type), alpha = 0.33) + geom_line(aes(color = Type), size = 1) +
theme_modern() + ylab("Reality Belief") + xlab("Paranormal Beliefs") + ggtitle("Effect of Paranormal Beliefs on Reality Perception") +
scale_color_manual(values = colors_fakereal) + scale_fill_manual(values = colors_fakereal)
Paranormal Belief has a significant positive effect on the belief of Fake News where individuals with higher level of paranormal beliefs are more likely to believe in fake news.
Religiosity
model_religiosity <- glmmTMB(News_Belief ~ Type/Religiosity + News_Familiarity +
(1 | Religion_Type) + (1 + Type | Participant) + (1 | Dataset) + (1 | News_Item),
data = df_scores)
model_parameters(model_religiosity)| Parameter | Coefficient | SE | CI_low | CI_high | z | df_error | p |
|---|---|---|---|---|---|---|---|
| (Intercept) | -1.38 | 0.31 | -1.98 | -0.77 | -4.46 | Inf | 0.00 |
| TypeReal News | 2.43 | 0.43 | 1.60 | 3.27 | 5.71 | Inf | 0.00 |
| News_Familiarity | 0.40 | 0.01 | 0.39 | 0.42 | 52.78 | Inf | 0.00 |
| TypeFake News:Religiosity | 0.17 | 0.06 | 0.06 | 0.29 | 2.91 | Inf | 0.00 |
| TypeReal News:Religiosity | 0.03 | 0.04 | -0.05 | 0.12 | 0.76 | Inf | 0.45 |
r2(model_religiosity)> # R2 for Mixed Models
>
> Conditional R2: 0.479
> Marginal R2: 0.357modelbased::estimate_link(model_religiosity, target = c("Type", "Religiosity")) %>%
ggplot(aes(x = Religiosity, y = Predicted)) + geom_ribbon(aes(ymin = CI_low,
ymax = CI_high, fill = Type), alpha = 0.33) + geom_line(aes(color = Type), size = 1) +
theme_modern() + ylab("Reality Belief") + xlab("Religiosity") + ggtitle("Effect of Religiosity on Reality Perception") +
scale_color_manual(values = colors_fakereal) + scale_fill_manual(values = colors_fakereal)
Religiosity has a significant positive effect on the belief of Fake News where individuals with higher level of religiosity are more likely to believe in fake news.
Negative Affect
model_negative <- glmmTMB(News_Belief ~ Type/Negative_Affect + News_Familiarity +
(1 + Type | Participant) + (1 | Dataset) + (1 | News_Item), data = df_scores)
model_parameters(model_negative)| Parameter | Coefficient | SE | CI_low | CI_high | z | df_error | p |
|---|---|---|---|---|---|---|---|
| (Intercept) | -1.32 | 0.31 | -1.92 | -0.72 | -4.30 | Inf | 0.00 |
| TypeReal News | 2.38 | 0.43 | 1.55 | 3.21 | 5.60 | Inf | 0.00 |
| News_Familiarity | 0.40 | 0.01 | 0.39 | 0.42 | 52.84 | Inf | 0.00 |
| TypeFake News:Negative_Affect | 0.26 | 0.05 | 0.15 | 0.36 | 4.72 | Inf | 0.00 |
| TypeReal News:Negative_Affect | 0.01 | 0.04 | -0.07 | 0.09 | 0.28 | Inf | 0.78 |
r2(model_negative)> # R2 for Mixed Models
>
> Conditional R2: 0.479
> Marginal R2: 0.359modelbased::estimate_link(model_negative, target = c("Type", "Negative_Affect")) %>%
ggplot(aes(x = Negative_Affect, y = Predicted)) + geom_ribbon(aes(ymin = CI_low,
ymax = CI_high, fill = Type), alpha = 0.33) + geom_line(aes(color = Type), size = 1) +
theme_modern() + ylab("Reality Belief") + xlab("Negative Affect") + ggtitle("Effect of Negative Affect on Reality Perception") +
scale_color_manual(values = colors_fakereal) + scale_fill_manual(values = colors_fakereal)
Negative Affect has a significant positive effect on the belief of Fake News where individuals with higher level of Negative Affect are more likely to believe in fake news.
Sensitivity
model_sensitivity <- glmmTMB(News_Belief ~ Type/Sensitivity + News_Familiarity +
(1 + Type | Participant) + (1 | Dataset) + (1 | News_Item), data = df_scores)
model_parameters(model_sensitivity)| Parameter | Coefficient | SE | CI_low | CI_high | z | df_error | p |
|---|---|---|---|---|---|---|---|
| (Intercept) | -1.33 | 0.31 | -1.93 | -0.73 | -4.3 | Inf | 0.00 |
| TypeReal News | 2.39 | 0.43 | 1.56 | 3.23 | 5.6 | Inf | 0.00 |
| News_Familiarity | 0.40 | 0.01 | 0.39 | 0.42 | 52.8 | Inf | 0.00 |
| TypeFake News:Sensitivity | 0.11 | 0.06 | 0.00 | 0.22 | 2.0 | Inf | 0.05 |
| TypeReal News:Sensitivity | 0.07 | 0.04 | -0.01 | 0.15 | 1.8 | Inf | 0.07 |
r2(model_sensitivity)> # R2 for Mixed Models
>
> Conditional R2: 0.479
> Marginal R2: 0.357modelbased::estimate_link(model_sensitivity, target = c("Type", "Sensitivity")) %>%
ggplot(aes(x = Sensitivity, y = Predicted)) + geom_ribbon(aes(ymin = CI_low,
ymax = CI_high, fill = Type), alpha = 0.33) + geom_line(aes(color = Type), size = 1) +
theme_modern() + ylab("Reality Belief") + xlab("Sensitivity") + ggtitle("Effect of Sensitivity on Reality Perception") +
scale_color_manual(values = colors_fakereal) + scale_fill_manual(values = colors_fakereal)
Sensitivity has marginal significant effect on the belief of Fake News.
Intolerance to Discomfort
model_intolerance <- glmmTMB(News_Belief ~ Type/Intolerance_Discomfort + News_Familiarity +
(1 + Type | Participant) + (1 | Dataset) + (1 | News_Item), data = df_scores)
model_parameters(model_intolerance)| Parameter | Coefficient | SE | CI_low | CI_high | z | df_error | p |
|---|---|---|---|---|---|---|---|
| (Intercept) | -1.34 | 0.31 | -1.94 | -0.74 | -4.4 | Inf | 0.00 |
| TypeReal News | 2.40 | 0.42 | 1.56 | 3.23 | 5.6 | Inf | 0.00 |
| News_Familiarity | 0.41 | 0.01 | 0.39 | 0.42 | 53.0 | Inf | 0.00 |
| TypeFake News:Intolerance_Discomfort | 0.16 | 0.06 | 0.05 | 0.28 | 2.7 | Inf | 0.01 |
| TypeReal News:Intolerance_Discomfort | 0.11 | 0.04 | 0.03 | 0.20 | 2.6 | Inf | 0.01 |
r2(model_intolerance)> # R2 for Mixed Models
>
> Conditional R2: 0.478
> Marginal R2: 0.357modelbased::estimate_link(model_intolerance, target = c("Type", "Intolerance_Discomfort")) %>%
ggplot(aes(x = Intolerance_Discomfort, y = Predicted)) + geom_ribbon(aes(ymin = CI_low,
ymax = CI_high, fill = Type), alpha = 0.33) + geom_line(aes(color = Type), size = 1) +
theme_modern() + ylab("Reality Belief") + xlab("Intolerance to Discomfort") +
ggtitle("Effect of Intolerance to Discomfort on Reality Perception") + scale_color_manual(values = colors_fakereal) +
scale_fill_manual(values = colors_fakereal)
Intolerance to Discomfort has a significant positive effect on the belief of both Real News and Fake News where individuals with higher level of intolerance to discomfort are more likely to believe in news in general.
SEM
df_sem <- df_scores %>%
group_by(Participant, Type, Dataset) %>%
select(Participant, Dataset, Type, News_Belief, Disorganized, Paranormal_Beliefs, Religiosity, Sensitivity, Intolerance_Discomfort, Negative_Affect, News_Familiarity, starts_with("Measure"), starts_with("Gov"), Education, starts_with("COVID_"), starts_with("Impact"), Frequency_COVID, SourcOfficialSites, SourcSharedLinks, SourcNewspaper) %>%
select(-COVID_Diagnosis) %>%
summarise_all(mean, na.rm=TRUE) %>%
pivot_wider(names_from = Type, values_from = c(News_Belief, News_Familiarity)) %>%
rename(Belief_FakeNews = `News_Belief_Fake News`,
Belief_RealNews = `News_Belief_Real News`,
Familiarity_FakeNews = `News_Familiarity_Fake News`,
Familiarity_RealNews = `News_Familiarity_Real News`)
# Adding News_Familiarity, Measures, Gov, Impact as predictors of Belief
sem_model <- '
# regressions
Belief_FakeNews ~ Disorganized + Religiosity + Paranormal_Beliefs + Negative_Affect + Sensitivity + Intolerance_Discomfort + Familiarity_FakeNews + Gov_G + Frequency_COVID + SourcOfficialSites + SourcSharedLinks
Belief_RealNews ~ Sensitivity + Intolerance_Discomfort + Familiarity_RealNews + Gov_G
MeasureG ~ Belief_FakeNews + Belief_RealNews + Gov_G + Frequency_COVID
# correlated residuals
Belief_FakeNews ~~ Belief_RealNews
Frequency_COVID ~~ SourcSharedLinks
Frequency_COVID ~~ SourcOfficialSites
'
mlav <- sem(sem_model, data = df_sem)
summary(mlav, fit.measures=TRUE)> lavaan 0.6-7 ended normally after 26 iterations
>
> Estimator ML
> Optimization method NLMINB
> Number of free parameters 73
>
> Used Total
> Number of observations 484 500
>
> Model Test User Model:
>
> Test statistic 170.656
> Degrees of freedom 47
> P-value (Chi-square) 0.000
>
> Model Test Baseline Model:
>
> Test statistic 778.081
> Degrees of freedom 69
> P-value 0.000
>
> User Model versus Baseline Model:
>
> Comparative Fit Index (CFI) 0.826
> Tucker-Lewis Index (TLI) 0.744
>
> Loglikelihood and Information Criteria:
>
> Loglikelihood user model (H0) -10962.509
> Loglikelihood unrestricted model (H1) -10877.181
>
> Akaike (AIC) 22071.017
> Bayesian (BIC) 22376.309
> Sample-size adjusted Bayesian (BIC) 22144.612
>
> Root Mean Square Error of Approximation:
>
> RMSEA 0.074
> 90 Percent confidence interval - lower 0.062
> 90 Percent confidence interval - upper 0.086
> P-value RMSEA <= 0.05 0.001
>
> Standardized Root Mean Square Residual:
>
> SRMR 0.074
>
> Parameter Estimates:
>
> Standard errors Standard
> Information Expected
> Information saturated (h1) model Structured
>
> Regressions:
> Estimate Std.Err z-value P(>|z|)
> Belief_FakeNews ~
> Disorganized -0.014 0.058 -0.241 0.810
> Religiosity 0.076 0.055 1.387 0.166
> Paranorml_Blfs 0.185 0.053 3.499 0.000
> Negative_Affct 0.213 0.056 3.824 0.000
> Sensitivity -0.030 0.055 -0.551 0.582
> Intlrnc_Dscmfr 0.005 0.059 0.080 0.937
> Familrty_FkNws 0.339 0.031 10.784 0.000
> Gov_G -0.078 0.050 -1.554 0.120
> Frequncy_COVID -0.088 0.044 -2.004 0.045
> SourcOfficlSts -0.030 0.032 -0.921 0.357
> SourcShardLnks 0.069 0.023 3.019 0.003
> Belief_RealNews ~
> Sensitivity 0.029 0.041 0.715 0.474
> Intlrnc_Dscmfr 0.105 0.043 2.443 0.015
> Familrty_RlNws 0.481 0.025 19.511 0.000
> Gov_G 0.093 0.043 2.180 0.029
> MeasureG ~
> Belief_FakeNws -0.033 0.035 -0.942 0.346
> Belief_RealNws 0.158 0.039 4.062 0.000
> Gov_G 0.193 0.045 4.296 0.000
> Frequncy_COVID 0.090 0.038 2.349 0.019
>
> Covariances:
> Estimate Std.Err z-value P(>|z|)
> .Belief_FakeNews ~~
> .Belief_RealNws 0.326 0.048 6.855 0.000
> Frequency_COVID ~~
> SourcShardLnks 0.321 0.105 3.048 0.002
> SourcOfficlSts 0.387 0.079 4.878 0.000
> Disorganized ~~
> Religiosity 0.158 0.044 3.631 0.000
> Paranorml_Blfs 0.247 0.046 5.387 0.000
> Negative_Affct 0.432 0.048 8.927 0.000
> Sensitivity 0.266 0.047 5.696 0.000
> Intlrnc_Dscmfr 0.297 0.045 6.680 0.000
> Familrty_FkNws 0.124 0.069 1.797 0.072
> Gov_G -0.029 0.044 -0.665 0.506
> Familrty_RlNws 0.068 0.073 0.932 0.351
> Religiosity ~~
> Paranorml_Blfs 0.344 0.048 7.153 0.000
> Negative_Affct 0.089 0.045 1.947 0.052
> Sensitivity 0.364 0.049 7.405 0.000
> Intlrnc_Dscmfr -0.028 0.043 -0.649 0.516
> Familrty_FkNws 0.165 0.071 2.336 0.019
> Gov_G -0.001 0.045 -0.030 0.976
> Familrty_RlNws 0.109 0.075 1.447 0.148
> Paranormal_Beliefs ~~
> Negative_Affct 0.206 0.048 4.317 0.000
> Sensitivity 0.338 0.050 6.728 0.000
> Intlrnc_Dscmfr 0.222 0.046 4.817 0.000
> Familrty_FkNws 0.120 0.073 1.645 0.100
> Gov_G 0.003 0.047 0.072 0.943
> Familrty_RlNws 0.024 0.078 0.309 0.758
> Negative_Affect ~~
> Sensitivity 0.188 0.048 3.893 0.000
> Intlrnc_Dscmfr 0.402 0.048 8.324 0.000
> Familrty_FkNws 0.168 0.073 2.305 0.021
> Gov_G -0.044 0.046 -0.942 0.346
> Familrty_RlNws 0.027 0.077 0.356 0.722
> Sensitivity ~~
> Intlrnc_Dscmfr 0.217 0.047 4.645 0.000
> Familrty_FkNws 0.206 0.075 2.759 0.006
> Gov_G -0.055 0.047 -1.170 0.242
> Familrty_RlNws 0.156 0.079 1.971 0.049
> Intolerance_Discomfort ~~
> Familrty_FkNws -0.052 0.069 -0.753 0.452
> Gov_G -0.018 0.044 -0.397 0.691
> Familrty_RlNws -0.042 0.074 -0.564 0.573
> Familiarity_FakeNews ~~
> Gov_G 0.060 0.072 0.833 0.405
> Familrty_RlNws 1.383 0.135 10.212 0.000
> Gov_G ~~
> Familrty_RlNws 0.524 0.080 6.522 0.000
>
> Variances:
> Estimate Std.Err z-value P(>|z|)
> .Belief_FakeNws 1.234 0.079 15.556 0.000
> .Belief_RealNws 0.802 0.052 15.556 0.000
> .MeasureG 0.888 0.057 15.556 0.000
> Frequncy_COVID 1.264 0.081 15.571 0.000
> SourcOfficlSts 2.334 0.150 15.556 0.000
> SourcShardLnks 4.398 0.283 15.556 0.000
> Disorganized 0.924 0.059 15.556 0.000
> Religiosity 0.969 0.062 15.556 0.000
> Paranorml_Blfs 1.036 0.067 15.556 0.000
> Negative_Affct 1.025 0.066 15.556 0.000
> Sensitivity 1.069 0.069 15.556 0.000
> Intlrnc_Dscmfr 0.942 0.061 15.556 0.000
> Familrty_FkNws 2.475 0.159 15.556 0.000
> Gov_G 1.013 0.065 15.556 0.000
> Familrty_RlNws 2.814 0.181 15.556 0.000# Remove insignificant links
sem_model2 <- '
# regressions
Belief_FakeNews ~ Paranormal_Beliefs + Negative_Affect + Familiarity_FakeNews + Frequency_COVID + SourcSharedLinks
Belief_RealNews ~ Intolerance_Discomfort + Familiarity_RealNews + Gov_G
MeasureG ~ Belief_RealNews + Gov_G + Frequency_COVID
# correlated residuals
Belief_FakeNews ~~ Belief_RealNews
Frequency_COVID ~~ SourcSharedLinks
'
mlav2 <- sem(sem_model2, data = df_sem)
summary(mlav2, fit.measures=TRUE)> lavaan 0.6-7 ended normally after 22 iterations
>
> Estimator ML
> Optimization method NLMINB
> Number of free parameters 40
>
> Used Total
> Number of observations 484 500
>
> Model Test User Model:
>
> Test statistic 135.045
> Degrees of freedom 26
> P-value (Chi-square) 0.000
>
> Model Test Baseline Model:
>
> Test statistic 710.940
> Degrees of freedom 40
> P-value 0.000
>
> User Model versus Baseline Model:
>
> Comparative Fit Index (CFI) 0.837
> Tucker-Lewis Index (TLI) 0.750
>
> Loglikelihood and Information Criteria:
>
> Loglikelihood user model (H0) -8207.052
> Loglikelihood unrestricted model (H1) -8139.529
>
> Akaike (AIC) 16494.104
> Bayesian (BIC) 16661.388
> Sample-size adjusted Bayesian (BIC) 16534.430
>
> Root Mean Square Error of Approximation:
>
> RMSEA 0.093
> 90 Percent confidence interval - lower 0.078
> 90 Percent confidence interval - upper 0.109
> P-value RMSEA <= 0.05 0.000
>
> Standardized Root Mean Square Residual:
>
> SRMR 0.086
>
> Parameter Estimates:
>
> Standard errors Standard
> Information Expected
> Information saturated (h1) model Structured
>
> Regressions:
> Estimate Std.Err z-value P(>|z|)
> Belief_FakeNews ~
> Paranorml_Blfs 0.201 0.048 4.166 0.000
> Negative_Affct 0.207 0.049 4.244 0.000
> Familrty_FkNws 0.337 0.031 10.817 0.000
> Frequncy_COVID -0.112 0.043 -2.610 0.009
> SourcShardLnks 0.070 0.023 3.027 0.002
> Belief_RealNews ~
> Intlrnc_Dscmfr 0.113 0.040 2.824 0.005
> Familrty_RlNws 0.483 0.025 19.685 0.000
> Gov_G 0.110 0.040 2.726 0.006
> MeasureG ~
> Belief_RealNws 0.145 0.036 4.010 0.000
> Gov_G 0.196 0.044 4.417 0.000
> Frequncy_COVID 0.092 0.038 2.420 0.016
>
> Covariances:
> Estimate Std.Err z-value P(>|z|)
> .Belief_FakeNews ~~
> .Belief_RealNws 0.327 0.048 6.836 0.000
> Frequency_COVID ~~
> SourcShardLnks 0.296 0.108 2.749 0.006
> .Belief_FakeNews ~~
> .MeasureG -0.039 0.045 -0.854 0.393
> Paranormal_Beliefs ~~
> Negative_Affct 0.206 0.048 4.317 0.000
> Familrty_FkNws 0.120 0.073 1.645 0.100
> Intlrnc_Dscmfr 0.222 0.046 4.817 0.000
> Familrty_RlNws 0.024 0.078 0.309 0.758
> Gov_G 0.003 0.047 0.072 0.943
> Negative_Affect ~~
> Familrty_FkNws 0.168 0.073 2.305 0.021
> Intlrnc_Dscmfr 0.402 0.048 8.324 0.000
> Familrty_RlNws 0.027 0.077 0.356 0.722
> Gov_G -0.044 0.046 -0.942 0.346
> Familiarity_FakeNews ~~
> Intlrnc_Dscmfr -0.052 0.069 -0.753 0.452
> Familrty_RlNws 1.383 0.135 10.212 0.000
> Gov_G 0.060 0.072 0.833 0.405
> Intolerance_Discomfort ~~
> Familrty_RlNws -0.042 0.074 -0.564 0.573
> Gov_G -0.018 0.044 -0.397 0.691
> Familiarity_RealNews ~~
> Gov_G 0.524 0.080 6.522 0.000
>
> Variances:
> Estimate Std.Err z-value P(>|z|)
> .Belief_FakeNws 1.246 0.080 15.557 0.000
> .Belief_RealNws 0.803 0.052 15.556 0.000
> .MeasureG 0.889 0.057 15.556 0.000
> Frequncy_COVID 1.260 0.081 15.556 0.000
> SourcShardLnks 4.398 0.283 15.556 0.000
> Paranorml_Blfs 1.036 0.067 15.556 0.000
> Negative_Affct 1.025 0.066 15.556 0.000
> Familrty_FkNws 2.475 0.159 15.556 0.000
> Intlrnc_Dscmfr 0.942 0.061 15.556 0.000
> Familrty_RlNws 2.814 0.181 15.556 0.000
> Gov_G 1.013 0.065 15.556 0.000as.data.frame(compare_performance(mlav, mlav2))| Name | Model | Chi2 | Chi2_df | p_Chi2 | Baseline | Baseline_df | p_Baseline | GFI | AGFI | NFI | NNFI | CFI | RMSEA | RMSEA_CI_low | RMSEA_CI_high | p_RMSEA | RMR | SRMR | RFI | PNFI | IFI | RNI | Loglikelihood | AIC | BIC | BIC_adjusted |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| mlav | lavaan | 171 | 47 | 0 | 778 | 69 | 0 | 0.96 | 0.89 | 0.78 | 0.74 | 0.83 | 0.07 | 0.06 | 0.09 | 0 | 0.14 | 0.07 | 0.68 | 0.53 | 0.83 | 0.83 | -10963 | 22071 | 22376 | 22145 |
| mlav2 | lavaan | 135 | 26 | 0 | 711 | 40 | 0 | 0.95 | 0.89 | 0.81 | 0.75 | 0.84 | 0.09 | 0.08 | 0.11 | 0 | 0.16 | 0.09 | 0.71 | 0.53 | 0.84 | 0.84 | -8207 | 16494 | 16661 | 16534 |
# Table of fit indices
sem_model_1 <- summary(mlav, fit.measures=TRUE)> lavaan 0.6-7 ended normally after 26 iterations
>
> Estimator ML
> Optimization method NLMINB
> Number of free parameters 73
>
> Used Total
> Number of observations 484 500
>
> Model Test User Model:
>
> Test statistic 170.656
> Degrees of freedom 47
> P-value (Chi-square) 0.000
>
> Model Test Baseline Model:
>
> Test statistic 778.081
> Degrees of freedom 69
> P-value 0.000
>
> User Model versus Baseline Model:
>
> Comparative Fit Index (CFI) 0.826
> Tucker-Lewis Index (TLI) 0.744
>
> Loglikelihood and Information Criteria:
>
> Loglikelihood user model (H0) -10962.509
> Loglikelihood unrestricted model (H1) -10877.181
>
> Akaike (AIC) 22071.017
> Bayesian (BIC) 22376.309
> Sample-size adjusted Bayesian (BIC) 22144.612
>
> Root Mean Square Error of Approximation:
>
> RMSEA 0.074
> 90 Percent confidence interval - lower 0.062
> 90 Percent confidence interval - upper 0.086
> P-value RMSEA <= 0.05 0.001
>
> Standardized Root Mean Square Residual:
>
> SRMR 0.074
>
> Parameter Estimates:
>
> Standard errors Standard
> Information Expected
> Information saturated (h1) model Structured
>
> Regressions:
> Estimate Std.Err z-value P(>|z|)
> Belief_FakeNews ~
> Disorganized -0.014 0.058 -0.241 0.810
> Religiosity 0.076 0.055 1.387 0.166
> Paranorml_Blfs 0.185 0.053 3.499 0.000
> Negative_Affct 0.213 0.056 3.824 0.000
> Sensitivity -0.030 0.055 -0.551 0.582
> Intlrnc_Dscmfr 0.005 0.059 0.080 0.937
> Familrty_FkNws 0.339 0.031 10.784 0.000
> Gov_G -0.078 0.050 -1.554 0.120
> Frequncy_COVID -0.088 0.044 -2.004 0.045
> SourcOfficlSts -0.030 0.032 -0.921 0.357
> SourcShardLnks 0.069 0.023 3.019 0.003
> Belief_RealNews ~
> Sensitivity 0.029 0.041 0.715 0.474
> Intlrnc_Dscmfr 0.105 0.043 2.443 0.015
> Familrty_RlNws 0.481 0.025 19.511 0.000
> Gov_G 0.093 0.043 2.180 0.029
> MeasureG ~
> Belief_FakeNws -0.033 0.035 -0.942 0.346
> Belief_RealNws 0.158 0.039 4.062 0.000
> Gov_G 0.193 0.045 4.296 0.000
> Frequncy_COVID 0.090 0.038 2.349 0.019
>
> Covariances:
> Estimate Std.Err z-value P(>|z|)
> .Belief_FakeNews ~~
> .Belief_RealNws 0.326 0.048 6.855 0.000
> Frequency_COVID ~~
> SourcShardLnks 0.321 0.105 3.048 0.002
> SourcOfficlSts 0.387 0.079 4.878 0.000
> Disorganized ~~
> Religiosity 0.158 0.044 3.631 0.000
> Paranorml_Blfs 0.247 0.046 5.387 0.000
> Negative_Affct 0.432 0.048 8.927 0.000
> Sensitivity 0.266 0.047 5.696 0.000
> Intlrnc_Dscmfr 0.297 0.045 6.680 0.000
> Familrty_FkNws 0.124 0.069 1.797 0.072
> Gov_G -0.029 0.044 -0.665 0.506
> Familrty_RlNws 0.068 0.073 0.932 0.351
> Religiosity ~~
> Paranorml_Blfs 0.344 0.048 7.153 0.000
> Negative_Affct 0.089 0.045 1.947 0.052
> Sensitivity 0.364 0.049 7.405 0.000
> Intlrnc_Dscmfr -0.028 0.043 -0.649 0.516
> Familrty_FkNws 0.165 0.071 2.336 0.019
> Gov_G -0.001 0.045 -0.030 0.976
> Familrty_RlNws 0.109 0.075 1.447 0.148
> Paranormal_Beliefs ~~
> Negative_Affct 0.206 0.048 4.317 0.000
> Sensitivity 0.338 0.050 6.728 0.000
> Intlrnc_Dscmfr 0.222 0.046 4.817 0.000
> Familrty_FkNws 0.120 0.073 1.645 0.100
> Gov_G 0.003 0.047 0.072 0.943
> Familrty_RlNws 0.024 0.078 0.309 0.758
> Negative_Affect ~~
> Sensitivity 0.188 0.048 3.893 0.000
> Intlrnc_Dscmfr 0.402 0.048 8.324 0.000
> Familrty_FkNws 0.168 0.073 2.305 0.021
> Gov_G -0.044 0.046 -0.942 0.346
> Familrty_RlNws 0.027 0.077 0.356 0.722
> Sensitivity ~~
> Intlrnc_Dscmfr 0.217 0.047 4.645 0.000
> Familrty_FkNws 0.206 0.075 2.759 0.006
> Gov_G -0.055 0.047 -1.170 0.242
> Familrty_RlNws 0.156 0.079 1.971 0.049
> Intolerance_Discomfort ~~
> Familrty_FkNws -0.052 0.069 -0.753 0.452
> Gov_G -0.018 0.044 -0.397 0.691
> Familrty_RlNws -0.042 0.074 -0.564 0.573
> Familiarity_FakeNews ~~
> Gov_G 0.060 0.072 0.833 0.405
> Familrty_RlNws 1.383 0.135 10.212 0.000
> Gov_G ~~
> Familrty_RlNws 0.524 0.080 6.522 0.000
>
> Variances:
> Estimate Std.Err z-value P(>|z|)
> .Belief_FakeNws 1.234 0.079 15.556 0.000
> .Belief_RealNws 0.802 0.052 15.556 0.000
> .MeasureG 0.888 0.057 15.556 0.000
> Frequncy_COVID 1.264 0.081 15.571 0.000
> SourcOfficlSts 2.334 0.150 15.556 0.000
> SourcShardLnks 4.398 0.283 15.556 0.000
> Disorganized 0.924 0.059 15.556 0.000
> Religiosity 0.969 0.062 15.556 0.000
> Paranorml_Blfs 1.036 0.067 15.556 0.000
> Negative_Affct 1.025 0.066 15.556 0.000
> Sensitivity 1.069 0.069 15.556 0.000
> Intlrnc_Dscmfr 0.942 0.061 15.556 0.000
> Familrty_FkNws 2.475 0.159 15.556 0.000
> Gov_G 1.013 0.065 15.556 0.000
> Familrty_RlNws 2.814 0.181 15.556 0.000sem_table_1 <- as.data.frame(t(as.data.frame(sem_model_1$FIT)))
sem_table_1 <- sem_table_1 %>%
select(chisq, df, pvalue, cfi, rmsea, srmr, aic, bic)
sem_model_2 <- summary(mlav2, fit.measures=TRUE)> lavaan 0.6-7 ended normally after 22 iterations
>
> Estimator ML
> Optimization method NLMINB
> Number of free parameters 40
>
> Used Total
> Number of observations 484 500
>
> Model Test User Model:
>
> Test statistic 135.045
> Degrees of freedom 26
> P-value (Chi-square) 0.000
>
> Model Test Baseline Model:
>
> Test statistic 710.940
> Degrees of freedom 40
> P-value 0.000
>
> User Model versus Baseline Model:
>
> Comparative Fit Index (CFI) 0.837
> Tucker-Lewis Index (TLI) 0.750
>
> Loglikelihood and Information Criteria:
>
> Loglikelihood user model (H0) -8207.052
> Loglikelihood unrestricted model (H1) -8139.529
>
> Akaike (AIC) 16494.104
> Bayesian (BIC) 16661.388
> Sample-size adjusted Bayesian (BIC) 16534.430
>
> Root Mean Square Error of Approximation:
>
> RMSEA 0.093
> 90 Percent confidence interval - lower 0.078
> 90 Percent confidence interval - upper 0.109
> P-value RMSEA <= 0.05 0.000
>
> Standardized Root Mean Square Residual:
>
> SRMR 0.086
>
> Parameter Estimates:
>
> Standard errors Standard
> Information Expected
> Information saturated (h1) model Structured
>
> Regressions:
> Estimate Std.Err z-value P(>|z|)
> Belief_FakeNews ~
> Paranorml_Blfs 0.201 0.048 4.166 0.000
> Negative_Affct 0.207 0.049 4.244 0.000
> Familrty_FkNws 0.337 0.031 10.817 0.000
> Frequncy_COVID -0.112 0.043 -2.610 0.009
> SourcShardLnks 0.070 0.023 3.027 0.002
> Belief_RealNews ~
> Intlrnc_Dscmfr 0.113 0.040 2.824 0.005
> Familrty_RlNws 0.483 0.025 19.685 0.000
> Gov_G 0.110 0.040 2.726 0.006
> MeasureG ~
> Belief_RealNws 0.145 0.036 4.010 0.000
> Gov_G 0.196 0.044 4.417 0.000
> Frequncy_COVID 0.092 0.038 2.420 0.016
>
> Covariances:
> Estimate Std.Err z-value P(>|z|)
> .Belief_FakeNews ~~
> .Belief_RealNws 0.327 0.048 6.836 0.000
> Frequency_COVID ~~
> SourcShardLnks 0.296 0.108 2.749 0.006
> .Belief_FakeNews ~~
> .MeasureG -0.039 0.045 -0.854 0.393
> Paranormal_Beliefs ~~
> Negative_Affct 0.206 0.048 4.317 0.000
> Familrty_FkNws 0.120 0.073 1.645 0.100
> Intlrnc_Dscmfr 0.222 0.046 4.817 0.000
> Familrty_RlNws 0.024 0.078 0.309 0.758
> Gov_G 0.003 0.047 0.072 0.943
> Negative_Affect ~~
> Familrty_FkNws 0.168 0.073 2.305 0.021
> Intlrnc_Dscmfr 0.402 0.048 8.324 0.000
> Familrty_RlNws 0.027 0.077 0.356 0.722
> Gov_G -0.044 0.046 -0.942 0.346
> Familiarity_FakeNews ~~
> Intlrnc_Dscmfr -0.052 0.069 -0.753 0.452
> Familrty_RlNws 1.383 0.135 10.212 0.000
> Gov_G 0.060 0.072 0.833 0.405
> Intolerance_Discomfort ~~
> Familrty_RlNws -0.042 0.074 -0.564 0.573
> Gov_G -0.018 0.044 -0.397 0.691
> Familiarity_RealNews ~~
> Gov_G 0.524 0.080 6.522 0.000
>
> Variances:
> Estimate Std.Err z-value P(>|z|)
> .Belief_FakeNws 1.246 0.080 15.557 0.000
> .Belief_RealNws 0.803 0.052 15.556 0.000
> .MeasureG 0.889 0.057 15.556 0.000
> Frequncy_COVID 1.260 0.081 15.556 0.000
> SourcShardLnks 4.398 0.283 15.556 0.000
> Paranorml_Blfs 1.036 0.067 15.556 0.000
> Negative_Affct 1.025 0.066 15.556 0.000
> Familrty_FkNws 2.475 0.159 15.556 0.000
> Intlrnc_Dscmfr 0.942 0.061 15.556 0.000
> Familrty_RlNws 2.814 0.181 15.556 0.000
> Gov_G 1.013 0.065 15.556 0.000sem_table_2 <- as.data.frame(t(as.data.frame(sem_model_2$FIT)))
sem_table_2 <- sem_table_2 %>%
select(chisq, df, pvalue, cfi, rmsea, srmr, aic, bic)
sem_table_indices <- rbind(sem_table_1, sem_table_2)
rownames(sem_table_indices) <- c("Initial Model", "Final Model")
colnames(sem_table_indices) <- c("$\\chi^2$" , "df", "$p$-value", "CFI", "RMSEA", "SRMR", "AIC", "BIC")
# Save table of fit indices
kableExtra::kbl(sem_table_indices, align = "c") %>%
kableExtra::kable_classic(full_width = F) %>%
kableExtra::footnote(general = "$\\chi^2$ = Chi-square; df = Degrees of Freedom; CFI = Confidence Free Interval; RMSEA = Root Mean Square Error of Approximation; SRMR = Standardized Root Mean Square Residual; AIC = Akaike Information Criterion; BIC = Bayesian Information Criterion.")| \(\chi^2\) | df | \(p\)-value | CFI | RMSEA | SRMR | AIC | BIC | |
|---|---|---|---|---|---|---|---|---|
| Initial Model | 171 | 47 | 0 | 0.83 | 0.07 | 0.07 | 22071 | 22376 |
| Final Model | 135 | 26 | 0 | 0.84 | 0.09 | 0.09 | 16494 | 16661 |
| Note: | ||||||||
| \(\chi^2\) = Chi-square; df = Degrees of Freedom; CFI = Confidence Free Interval; RMSEA = Root Mean Square Error of Approximation; SRMR = Standardized Root Mean Square Residual; AIC = Akaike Information Criterion; BIC = Bayesian Information Criterion. |
# kableExtra::kbl(sem_table_indices, align = "c") %>%
# kableExtra::kable_classic(full_width = F) %>%
# kableExtra::footnote(general = "$\\chi^2$ = Chi-square; df = Degrees of Freedom; CFI = Confidence Free Interval; RMSEA = Root Mean Square Error of Approximation; SRMR = Standardized Root Mean Square Residual; AIC = Akaike Information Criterion; BIC = Bayesian Information Criterion.") %>%
# kableExtra::save_kable("figures/sem_table.pdf") # saving like this results in raw strings without math symbols, need to save manually
sem_model_2$PE %>%
filter(pvalue < 0.03) %>%
filter(row_number() <= n()-17) %>%
mutate(Variables = paste(lhs, op, rhs)) %>%
rename(c("Standard Error" = "se",
"p value" = "pvalue",
"Standardized Coefficients" = "est")) %>%
select("Variables", "Standardized Coefficients", "Standard Error", "p value") %>%
kableExtra::kbl(align = "c") %>%
kableExtra::kable_classic(full_width = F) %>%
kableExtra::footnote(general = "Belief_*News = Belief in COVID-19 fake/real news items; Familiarity_*News = Perceived familiarity of COVID-19 fake/real news items; Frequency_COVID = Frequency of Reading COVID-19 related news; Gov_G = Government Opinions; MeasureG = Compliance to COVID-19 Precautionery Measures") | Variables | Standardized Coefficients | Standard Error | p value |
|---|---|---|---|
| Belief_FakeNews ~ Paranormal_Beliefs | 0.20 | 0.05 | 0.00 |
| Belief_FakeNews ~ Negative_Affect | 0.21 | 0.05 | 0.00 |
| Belief_FakeNews ~ Familiarity_FakeNews | 0.34 | 0.03 | 0.00 |
| Belief_FakeNews ~ Frequency_COVID | -0.11 | 0.04 | 0.01 |
| Belief_FakeNews ~ SourcSharedLinks | 0.07 | 0.02 | 0.00 |
| Belief_RealNews ~ Intolerance_Discomfort | 0.11 | 0.04 | 0.00 |
| Belief_RealNews ~ Familiarity_RealNews | 0.48 | 0.02 | 0.00 |
| Belief_RealNews ~ Gov_G | 0.11 | 0.04 | 0.01 |
| MeasureG ~ Belief_RealNews | 0.15 | 0.04 | 0.00 |
| MeasureG ~ Gov_G | 0.20 | 0.04 | 0.00 |
| MeasureG ~ Frequency_COVID | 0.09 | 0.04 | 0.02 |
| Belief_FakeNews ~~ Belief_RealNews | 0.33 | 0.05 | 0.00 |
| Frequency_COVID ~~ SourcSharedLinks | 0.30 | 0.11 | 0.01 |
| Note: | |||
| Belief_News = Belief in COVID-19 fake/real news items; Familiarity_News = Perceived familiarity of COVID-19 fake/real news items; Frequency_COVID = Frequency of Reading COVID-19 related news; Gov_G = Government Opinions; MeasureG = Compliance to COVID-19 Precautionery Measures |
# Plot
## Extract standardized parameters
sem_parameters <-model_parameters(mlav2, standardize = FALSE) %>%
filter(p < .03) %>%
filter(abs(Coefficient) > 0.069)
data_plot <- see::data_plot(sem_parameters, ci=FALSE)
data_plot$nodes <- mutate(data_plot$nodes,
Name = str_replace(Name, "Paranormal_Beliefs", "Paranormal\nBeliefs"),
Name = str_replace(Name, "Negative_Affect", "Negative\nAffect"),
Name =
str_replace(Name, "Familiarity_FakeNews", "Fake News \nFamiliarity"),
Name =
str_replace(Name, "Gov_G", "Government\nOpinions"),
Name =
str_replace(Name, "Familiarity_RealNews", "Real News \nFamiliarity"),
Name =
str_replace(Name, "Belief_RealNews", "Real News\nBelief"),
Name =
str_replace(Name, "Intolerance_Discomfort", "Intolerance to\nDiscomfort"),
Name =
str_replace(Name, "Impact_G", "Personal\nImpact"),
Name =
str_replace(Name, "Belief_FakeNews", "Fake News\nBelief"),
Name =
str_replace(Name, "MeasureG", "Measure\nCompliance"),
Name =
str_replace(Name, "Frequency_COVID", "Frequency\nof Reading\nNews"),
Name =
str_replace(Name, "SourcSharedLinks", "Reading from\nShared Links"),
Name =
str_replace(Name, "SourcNewspaper", "Reading from\nNewspaper")
)
data_plot$edges <- mutate(data_plot$edges,
from = str_replace(from, "Paranormal_Beliefs", "Paranormal\nBeliefs"),
from = str_replace(from, "Negative_Affect", "Negative\nAffect"),
from = str_replace(from, "Familiarity_FakeNews", "Fake News \nFamiliarity"),
from = str_replace(from, "Gov_G", "Government\nOpinions"),
from = str_replace(from, "Familiarity_RealNews", "Real News \nFamiliarity"),
from = str_replace(from, "Belief_RealNews", "Real News\nBelief"),
from = str_replace(from, "Intolerance_Discomfort", "Intolerance to\nDiscomfort"),
from = str_replace(from, "Impact_G", "Personal\nImpact"),
from = str_replace(from, "Belief_FakeNews", "Fake News\nBelief"),
from = str_replace(from, "MeasureG", "Measure\nCompliance"),
from = str_replace(from, "SourcSharedLinks", "Reading from\nShared Links"),
from = str_replace(from, "Frequency_COVID", "Frequency\nof Reading\nNews")
)
data_plot$edges <- mutate(data_plot$edges,
to = str_replace(to, "Paranormal_Beliefs", "Paranormal\nBeliefs"),
to = str_replace(to, "Negative_Affect", "Negative\nAffect"),
to = str_replace(to, "Familiarity_FakeNews", "Fake News \nFamiliarity"),
to = str_replace(to, "Gov_G", "Government\nOpinions"),
to = str_replace(to, "Familiarity_RealNews", "Real News \nFamiliarity"),
to = str_replace(to, "Belief_RealNews", "Real News\nBelief"),
to = str_replace(to, "Intolerance_Discomfort", "Intolerance to\nDiscomfort"),
to = str_replace(to, "Impact_G", "Personal\nImpact"),
to = str_replace(to, "Belief_FakeNews", "Fake News\nBelief"),
to =
str_replace(to, "MeasureG", "Measure\nCompliance"),
to =
str_replace(to, "Frequency_COVID", "Frequency\nof Reading\nNews"),
to =
str_replace(to, "SourcSharedLinks", "Reading from\nShared Links"),
to =
str_replace(to, "SourcNewspaper", "Reading from\nNewspaper")
)
set.seed(222)
sem_plot <- tidygraph::tbl_graph(data_plot$nodes, data_plot$edges) %>%
ggraph::ggraph(layout = 'graphopt') +
# Correlation
ggraph::geom_edge_arc(aes(alpha = as.numeric(Type == "Correlation"),
label = Label_Correlation,
color = Coefficient),
strength = 0.2,
edge_width = 0.5,
label_size = 2.1,
label_dodge = unit(2, "mm"),
linetype = 2, angle_calc = "along",
start_cap = ggraph::circle(0, 'mm'), end_cap = ggraph::circle(0, 'mm')) +
ggraph::geom_edge_link(aes(alpha = as.numeric(Type == "Regression"),
label = Label_Regression,
color = Coefficient),
label_dodge = unit(2, "mm"),
angle_calc = "along",
edge_width = 0.9,
label_size = 2.7,
#check_overlap = TRUE,
arrow = arrow(type = "closed", length = unit(3, "mm")),
start_cap = ggraph::circle(0, 'mm'), end_cap = ggraph::circle(-12, 'mm')) +
ggraph::geom_node_point(aes(colour = Name, size = Latent)) +
ggraph::geom_node_text(aes(label = Name), size = 3) +
ggraph::scale_edge_colour_gradient2(
guide = FALSE,
high = "#4CAF50",
mid = "#FFF9C4",
low = "#E91E63"
) +
scale_alpha(guide = FALSE, range = c(0, 1)) +
scale_size_manual(values=c("TRUE"=33, "FALSE"=22)) +
scale_color_manual(values=c(
#""="#E91E63",
#""="#EC407A",
"Fake News\nBelief"="#f58caf",
"Fake News \nFamiliarity"="#f7bace",
#""="#F8BBD0",
"Measure\nCompliance"="#FF3300",
"Reading from\nShared Links"="#fcd397",
"Frequency\nof Reading\nNews"="#f7bf6d",
"Government\nOpinions"="#FF6600",
"Real News\nBelief"="#63d10f",
#""="#66BB6A",
"Q4"="#81C784",
"Real News \nFamiliarity"="#9be663",
"Q23"="#C8E6C9",
"Paranormal\nBeliefs"="#2196F3",
"Disorganized"="#64B5F6",
"Religiosity"="#4FC3F7",
"Negative\nAffect"="#a88ade",
"Intolerance to\nDiscomfort"="#9575CD",
"Sensitivity"="#BA68C8")) +
ggraph::scale_edge_alpha(guide = FALSE, range = c(0, 1)) +
scale_x_continuous(expand = expansion(c(0.07, 0.07))) +
scale_y_continuous(expand = expansion(c(0.07, 0.07))) +
ggraph::theme_graph() +
theme(legend.position = "none")
sem_plot
ggsave("figures/sem_plot.png", sem_plot, height=figheight*1.2, width=figwidth, dpi=600)